Commit | Line | Data |
---|---|---|
ba83908c | 1 | ;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*- |
7f925a67 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2010-2014 Free Software Foundation, Inc. |
7f925a67 SM |
4 | |
5 | ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> | |
6 | ;; Keywords: languages, lisp, internal, parsing, indentation | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with this program. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; While working on the SML indentation code, the idea grew that maybe | |
26 | ;; I could write something generic to do the same thing, and at the | |
27 | ;; end of working on the SML code, I had a pretty good idea of what it | |
28 | ;; could look like. That idea grew stronger after working on | |
29 | ;; LaTeX indentation. | |
30 | ;; | |
31 | ;; So at some point I decided to try it out, by writing a new | |
32 | ;; indentation code for Coq while trying to keep most of the code | |
33 | ;; "table driven", where only the tables are Coq-specific. The result | |
34 | ;; (which was used for Beluga-mode as well) turned out to be based on | |
35 | ;; something pretty close to an operator precedence parser. | |
36 | ||
37 | ;; So here is another rewrite, this time following the actual principles of | |
38 | ;; operator precedence grammars. Why OPG? Even though they're among the | |
39 | ;; weakest kinds of parsers, these parsers have some very desirable properties | |
40 | ;; for Emacs: | |
41 | ;; - most importantly for indentation, they work equally well in either | |
42 | ;; direction, so you can use them to parse backward from the indentation | |
43 | ;; point to learn the syntactic context; | |
44 | ;; - they work locally, so there's no need to keep a cache of | |
45 | ;; the parser's state; | |
46 | ;; - because of that locality, indentation also works just fine when earlier | |
47 | ;; parts of the buffer are syntactically incorrect since the indentation | |
48 | ;; looks at "as little as possible" of the buffer to make an indentation | |
49 | ;; decision. | |
50 | ;; - they typically have no error handling and can't even detect a parsing | |
51 | ;; error, so we don't have to worry about what to do in case of a syntax | |
52 | ;; error because the parser just automatically does something. Better yet, | |
53 | ;; we can afford to use a sloppy grammar. | |
54 | ||
55 | ;; A good background to understand the development (especially the parts | |
56 | ;; building the 2D precedence tables and then computing the precedence levels | |
57 | ;; from it) can be found in pages 187-194 of "Parsing techniques" by Dick Grune | |
58 | ;; and Ceriel Jacobs (BookBody.pdf available at | |
e96e3013 | 59 | ;; http://dickgrune.com/Books/PTAPG_1st_Edition/). |
7f925a67 SM |
60 | ;; |
61 | ;; OTOH we had to kill many chickens, read many coffee grounds, and practice | |
62 | ;; untold numbers of black magic spells, to come up with the indentation code. | |
63 | ;; Since then, some of that code has been beaten into submission, but the | |
64 | ;; smie-indent-keyword is still pretty obscure. | |
65 | ||
7bea8c7a SM |
66 | ;; Conflict resolution: |
67 | ;; | |
68 | ;; - One source of conflicts is when you have: | |
69 | ;; (exp ("IF" exp "ELSE" exp "END") ("CASE" cases "END")) | |
70 | ;; (cases (cases "ELSE" insts) ...) | |
71 | ;; The IF-rule implies ELSE=END and the CASE-rule implies ELSE>END. | |
2ad52c60 SM |
72 | ;; This can be resolved simply with: |
73 | ;; (exp ("IF" expelseexp "END") ("CASE" cases "END")) | |
74 | ;; (expelseexp (exp) (exp "ELSE" exp)) | |
75 | ;; (cases (cases "ELSE" insts) ...) | |
76 | ;; - Another source of conflict is when a terminator/separator is used to | |
77 | ;; terminate elements at different levels, as in: | |
78 | ;; (decls ("VAR" vars) (decls "," decls)) | |
79 | ;; (vars (id) (vars "," vars)) | |
80 | ;; often these can be resolved by making the lexer distinguish the two | |
81 | ;; kinds of commas, e.g. based on the following token. | |
7bea8c7a | 82 | |
10b40d2e SM |
83 | ;; TODO & BUGS: |
84 | ;; | |
2ad52c60 SM |
85 | ;; - We could try to resolve conflicts such as the IFexpELSEexpEND -vs- |
86 | ;; CASE(casesELSEexp)END automatically by changing the way BNF rules such as | |
87 | ;; the IF-rule is handled. I.e. rather than IF=ELSE and ELSE=END, we could | |
88 | ;; turn them into IF<ELSE and ELSE>END and IF=END. | |
10b40d2e SM |
89 | ;; - Using the structural information SMIE gives us, it should be possible to |
90 | ;; implement a `smie-align' command that would automatically figure out what | |
91 | ;; there is to align and how to do it (something like: align the token of | |
92 | ;; lowest precedence that appears the same number of times on all lines, | |
93 | ;; and then do the same on each side of that token). | |
94 | ;; - Maybe accept two juxtaposed non-terminals in the BNF under the condition | |
95 | ;; that the first always ends with a terminal, or that the second always | |
96 | ;; starts with a terminal. | |
0ac30604 SM |
97 | ;; - Permit EBNF-style notation. |
98 | ;; - If the grammar has conflicts, the only way is to make the lexer return | |
99 | ;; different tokens for the different cases. This extra work performed by | |
100 | ;; the lexer can be costly and unnecessary: we perform this extra work every | |
101 | ;; time we find the conflicting token, regardless of whether or not the | |
102 | ;; difference between the various situations is relevant to the current | |
103 | ;; situation. E.g. we may try to determine whether a ";" is a ";-operator" | |
104 | ;; or a ";-separator" in a case where we're skipping over a "begin..end" pair | |
105 | ;; where the difference doesn't matter. For frequently occurring tokens and | |
106 | ;; rarely occurring conflicts, this can be a significant performance problem. | |
107 | ;; We could try and let the lexer return a "set of possible tokens | |
108 | ;; plus a refinement function" and then let parser call the refinement | |
109 | ;; function if needed. | |
110 | ;; - Make it possible to better specify the behavior in the face of | |
111 | ;; syntax errors. IOW provide some control over the choice of precedence | |
112 | ;; levels within the limits of the constraints. E.g. make it possible for | |
113 | ;; the grammar to specify that "begin..end" has lower precedence than | |
114 | ;; "Module..EndModule", so that if a "begin" is missing, scanning from the | |
115 | ;; "end" will stop at "Module" rather than going past it (and similarly, | |
116 | ;; scanning from "Module" should not stop at a spurious "end"). | |
7f925a67 | 117 | |
10b40d2e | 118 | ;;; Code: |
7f925a67 | 119 | |
2ad52c60 SM |
120 | ;; FIXME: |
121 | ;; - smie-indent-comment doesn't interact well with mis-indented lines (where | |
122 | ;; the indent rules don't do what the user wants). Not sure what to do. | |
123 | ||
f80efb86 | 124 | (eval-when-compile (require 'cl-lib)) |
7f925a67 SM |
125 | |
126 | (defgroup smie nil | |
127 | "Simple Minded Indentation Engine." | |
128 | :group 'languages) | |
129 | ||
130 | (defvar comment-continue) | |
131 | (declare-function comment-string-strip "newcomment" (str beforep afterp)) | |
132 | ||
133 | ;;; Building precedence level tables from BNF specs. | |
134 | ||
135 | ;; We have 4 different representations of a "grammar": | |
136 | ;; - a BNF table, which is a list of BNF rules of the form | |
137 | ;; (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens) | |
138 | ;; or nonterminals. Any element in these lists which does not appear as | |
139 | ;; the `car' of a BNF rule is taken to be a terminal. | |
140 | ;; - A list of precedences (key word "precs"), is a list, sorted | |
141 | ;; from lowest to highest precedence, of precedence classes that | |
142 | ;; have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where | |
143 | ;; ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'. | |
144 | ;; - a 2 dimensional precedence table (key word "prec2"), is a 2D | |
145 | ;; table recording the precedence relation (can be `<', `=', `>', or | |
146 | ;; nil) between each pair of tokens. | |
58179cce | 147 | ;; - a precedence-level table (key word "grammar"), which is an alist |
7f925a67 SM |
148 | ;; giving for each token its left and right precedence level (a |
149 | ;; number or nil). This is used in `smie-grammar'. | |
150 | ;; The prec2 tables are only intermediate data structures: the source | |
151 | ;; code normally provides a mix of BNF and precs tables, and then | |
152 | ;; turns them into a levels table, which is what's used by the rest of | |
153 | ;; the SMIE code. | |
154 | ||
2ad52c60 SM |
155 | (defvar smie-warning-count 0) |
156 | ||
7f925a67 | 157 | (defun smie-set-prec2tab (table x y val &optional override) |
f80efb86 | 158 | (cl-assert (and x y)) |
7f925a67 SM |
159 | (let* ((key (cons x y)) |
160 | (old (gethash key table))) | |
161 | (if (and old (not (eq old val))) | |
162 | (if (and override (gethash key override)) | |
163 | ;; FIXME: The override is meant to resolve ambiguities, | |
164 | ;; but it also hides real conflicts. It would be great to | |
165 | ;; be able to distinguish the two cases so that overrides | |
166 | ;; don't hide real conflicts. | |
167 | (puthash key (gethash key override) table) | |
2ad52c60 | 168 | (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)) |
f80efb86 | 169 | (cl-incf smie-warning-count)) |
7f925a67 SM |
170 | (puthash key val table)))) |
171 | ||
172 | (put 'smie-precs->prec2 'pure t) | |
173 | (defun smie-precs->prec2 (precs) | |
174 | "Compute a 2D precedence table from a list of precedences. | |
175 | PRECS should be a list, sorted by precedence (e.g. \"+\" will | |
176 | come before \"*\"), of elements of the form \(left OP ...) | |
177 | or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in | |
178 | one of those elements share the same precedence level and associativity." | |
179 | (let ((prec2-table (make-hash-table :test 'equal))) | |
180 | (dolist (prec precs) | |
181 | (dolist (op (cdr prec)) | |
182 | (let ((selfrule (cdr (assq (car prec) | |
183 | '((left . >) (right . <) (assoc . =)))))) | |
184 | (when selfrule | |
185 | (dolist (other-op (cdr prec)) | |
186 | (smie-set-prec2tab prec2-table op other-op selfrule)))) | |
187 | (let ((op1 '<) (op2 '>)) | |
188 | (dolist (other-prec precs) | |
189 | (if (eq prec other-prec) | |
190 | (setq op1 '> op2 '<) | |
191 | (dolist (other-op (cdr other-prec)) | |
192 | (smie-set-prec2tab prec2-table op other-op op2) | |
193 | (smie-set-prec2tab prec2-table other-op op op1))))))) | |
194 | prec2-table)) | |
195 | ||
196 | (put 'smie-merge-prec2s 'pure t) | |
197 | (defun smie-merge-prec2s (&rest tables) | |
198 | (if (null (cdr tables)) | |
199 | (car tables) | |
200 | (let ((prec2 (make-hash-table :test 'equal))) | |
201 | (dolist (table tables) | |
202 | (maphash (lambda (k v) | |
203 | (if (consp k) | |
204 | (smie-set-prec2tab prec2 (car k) (cdr k) v) | |
205 | (if (and (gethash k prec2) | |
206 | (not (equal (gethash k prec2) v))) | |
207 | (error "Conflicting values for %s property" k) | |
208 | (puthash k v prec2)))) | |
209 | table)) | |
210 | prec2))) | |
211 | ||
212 | (put 'smie-bnf->prec2 'pure t) | |
2ad52c60 SM |
213 | (defun smie-bnf->prec2 (bnf &rest resolvers) |
214 | "Convert the BNF grammar into a prec2 table. | |
215 | BNF is a list of nonterminal definitions of the form: | |
216 | \(NONTERM RHS1 RHS2 ...) | |
217 | where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals. | |
218 | Not all grammars are accepted: | |
219 | - an RHS cannot be an empty list (this is not needed, since SMIE allows all | |
220 | non-terminals to match the empty string anyway). | |
221 | - an RHS cannot have 2 consecutive non-terminals: between each non-terminal | |
222 | needs to be a terminal (aka token). This is a fundamental limitation of | |
223 | the parsing technology used (operator precedence grammar). | |
224 | Additionally, conflicts can occur: | |
225 | - The returned prec2 table holds constraints between pairs of | |
226 | token, and for any given pair only one constraint can be | |
227 | present, either: T1 < T2, T1 = T2, or T1 > T2. | |
228 | - A token can either be an `opener' (something similar to an open-paren), | |
229 | a `closer' (like a close-paren), or `neither' of the two (e.g. an infix | |
230 | operator, or an inner token like \"else\"). | |
231 | Conflicts can be resolved via RESOLVERS, which is a list of elements that can | |
232 | be either: | |
233 | - a precs table (see `smie-precs->prec2') to resolve conflicting constraints, | |
234 | - a constraint (T1 REL T2) where REL is one of = < or >." | |
7bea8c7a SM |
235 | ;; FIXME: Add repetition operator like (repeat <separator> <elems>). |
236 | ;; Maybe also add (or <elem1> <elem2>...) for things like | |
237 | ;; (exp (exp (or "+" "*" "=" ..) exp)). | |
238 | ;; Basically, make it EBNF (except for the specification of a separator in | |
ba83908c | 239 | ;; the repetition, maybe). |
2ad52c60 SM |
240 | (let* ((nts (mapcar 'car bnf)) ;Non-terminals. |
241 | (first-ops-table ()) | |
242 | (last-ops-table ()) | |
243 | (first-nts-table ()) | |
244 | (last-nts-table ()) | |
245 | (smie-warning-count 0) | |
246 | (prec2 (make-hash-table :test 'equal)) | |
247 | (override | |
248 | (let ((precs ()) | |
249 | (over (make-hash-table :test 'equal))) | |
250 | (dolist (resolver resolvers) | |
251 | (cond | |
252 | ((and (= 3 (length resolver)) (memq (nth 1 resolver) '(= < >))) | |
253 | (smie-set-prec2tab | |
254 | over (nth 0 resolver) (nth 2 resolver) (nth 1 resolver))) | |
255 | ((memq (caar resolver) '(left right assoc nonassoc)) | |
256 | (push resolver precs)) | |
257 | (t (error "Unknown resolver %S" resolver)))) | |
258 | (apply #'smie-merge-prec2s over | |
259 | (mapcar 'smie-precs->prec2 precs)))) | |
260 | again) | |
7f925a67 SM |
261 | (dolist (rules bnf) |
262 | (let ((nt (car rules)) | |
263 | (last-ops ()) | |
264 | (first-ops ()) | |
265 | (last-nts ()) | |
266 | (first-nts ())) | |
267 | (dolist (rhs (cdr rules)) | |
268 | (unless (consp rhs) | |
269 | (signal 'wrong-type-argument `(consp ,rhs))) | |
270 | (if (not (member (car rhs) nts)) | |
f80efb86 SM |
271 | (cl-pushnew (car rhs) first-ops) |
272 | (cl-pushnew (car rhs) first-nts) | |
7f925a67 SM |
273 | (when (consp (cdr rhs)) |
274 | ;; If the first is not an OP we add the second (which | |
275 | ;; should be an OP if BNF is an "operator grammar"). | |
276 | ;; Strictly speaking, this should only be done if the | |
277 | ;; first is a non-terminal which can expand to a phrase | |
278 | ;; without any OP in it, but checking doesn't seem worth | |
279 | ;; the trouble, and it lets the writer of the BNF | |
280 | ;; be a bit more sloppy by skipping uninteresting base | |
281 | ;; cases which are terminals but not OPs. | |
273d2baf SM |
282 | (when (member (cadr rhs) nts) |
283 | (error "Adjacent non-terminals: %s %s" | |
284 | (car rhs) (cadr rhs))) | |
f80efb86 | 285 | (cl-pushnew (cadr rhs) first-ops))) |
7f925a67 SM |
286 | (let ((shr (reverse rhs))) |
287 | (if (not (member (car shr) nts)) | |
f80efb86 SM |
288 | (cl-pushnew (car shr) last-ops) |
289 | (cl-pushnew (car shr) last-nts) | |
7f925a67 | 290 | (when (consp (cdr shr)) |
bc312254 | 291 | (when (member (cadr shr) nts) |
273d2baf | 292 | (error "Adjacent non-terminals: %s %s" |
bc312254 | 293 | (cadr shr) (car shr))) |
f80efb86 | 294 | (cl-pushnew (cadr shr) last-ops))))) |
7f925a67 SM |
295 | (push (cons nt first-ops) first-ops-table) |
296 | (push (cons nt last-ops) last-ops-table) | |
297 | (push (cons nt first-nts) first-nts-table) | |
298 | (push (cons nt last-nts) last-nts-table))) | |
299 | ;; Compute all first-ops by propagating the initial ones we have | |
300 | ;; now, according to first-nts. | |
301 | (setq again t) | |
302 | (while (prog1 again (setq again nil)) | |
303 | (dolist (first-nts first-nts-table) | |
304 | (let* ((nt (pop first-nts)) | |
305 | (first-ops (assoc nt first-ops-table))) | |
306 | (dolist (first-nt first-nts) | |
307 | (dolist (op (cdr (assoc first-nt first-ops-table))) | |
308 | (unless (member op first-ops) | |
309 | (setq again t) | |
2ee3d7f0 | 310 | (push op (cdr first-ops)))))))) |
7f925a67 SM |
311 | ;; Same thing for last-ops. |
312 | (setq again t) | |
313 | (while (prog1 again (setq again nil)) | |
314 | (dolist (last-nts last-nts-table) | |
315 | (let* ((nt (pop last-nts)) | |
316 | (last-ops (assoc nt last-ops-table))) | |
317 | (dolist (last-nt last-nts) | |
318 | (dolist (op (cdr (assoc last-nt last-ops-table))) | |
319 | (unless (member op last-ops) | |
320 | (setq again t) | |
2ee3d7f0 | 321 | (push op (cdr last-ops)))))))) |
7f925a67 SM |
322 | ;; Now generate the 2D precedence table. |
323 | (dolist (rules bnf) | |
324 | (dolist (rhs (cdr rules)) | |
325 | (while (cdr rhs) | |
326 | (cond | |
327 | ((member (car rhs) nts) | |
328 | (dolist (last (cdr (assoc (car rhs) last-ops-table))) | |
329 | (smie-set-prec2tab prec2 last (cadr rhs) '> override))) | |
330 | ((member (cadr rhs) nts) | |
331 | (dolist (first (cdr (assoc (cadr rhs) first-ops-table))) | |
332 | (smie-set-prec2tab prec2 (car rhs) first '< override)) | |
333 | (if (and (cddr rhs) (not (member (car (cddr rhs)) nts))) | |
334 | (smie-set-prec2tab prec2 (car rhs) (car (cddr rhs)) | |
335 | '= override))) | |
336 | (t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override))) | |
337 | (setq rhs (cdr rhs))))) | |
338 | ;; Keep track of which tokens are openers/closer, so they can get a nil | |
339 | ;; precedence in smie-prec2->grammar. | |
2ad52c60 SM |
340 | (puthash :smie-open/close-alist (smie-bnf--classify bnf) prec2) |
341 | (puthash :smie-closer-alist (smie-bnf--closer-alist bnf) prec2) | |
342 | (if (> smie-warning-count 0) | |
343 | (display-warning | |
344 | 'smie (format "Total: %d warnings" smie-warning-count))) | |
7f925a67 SM |
345 | prec2)) |
346 | ||
347 | ;; (defun smie-prec2-closer-alist (prec2 include-inners) | |
348 | ;; "Build a closer-alist from a PREC2 table. | |
349 | ;; The return value is in the same form as `smie-closer-alist'. | |
350 | ;; INCLUDE-INNERS if non-nil means that inner keywords will be included | |
351 | ;; in the table, e.g. the table will include things like (\"if\" . \"else\")." | |
352 | ;; (let* ((non-openers '()) | |
353 | ;; (non-closers '()) | |
354 | ;; ;; For each keyword, this gives the matching openers, if any. | |
355 | ;; (openers (make-hash-table :test 'equal)) | |
356 | ;; (closers '()) | |
357 | ;; (done nil)) | |
358 | ;; ;; First, find the non-openers and non-closers. | |
359 | ;; (maphash (lambda (k v) | |
360 | ;; (unless (or (eq v '<) (member (cdr k) non-openers)) | |
361 | ;; (push (cdr k) non-openers)) | |
362 | ;; (unless (or (eq v '>) (member (car k) non-closers)) | |
363 | ;; (push (car k) non-closers))) | |
364 | ;; prec2) | |
365 | ;; ;; Then find the openers and closers. | |
366 | ;; (maphash (lambda (k _) | |
367 | ;; (unless (member (car k) non-openers) | |
368 | ;; (puthash (car k) (list (car k)) openers)) | |
369 | ;; (unless (or (member (cdr k) non-closers) | |
370 | ;; (member (cdr k) closers)) | |
371 | ;; (push (cdr k) closers))) | |
372 | ;; prec2) | |
373 | ;; ;; Then collect the matching elements. | |
374 | ;; (while (not done) | |
375 | ;; (setq done t) | |
376 | ;; (maphash (lambda (k v) | |
377 | ;; (when (eq v '=) | |
378 | ;; (let ((aopeners (gethash (car k) openers)) | |
379 | ;; (dopeners (gethash (cdr k) openers)) | |
380 | ;; (new nil)) | |
381 | ;; (dolist (o aopeners) | |
382 | ;; (unless (member o dopeners) | |
383 | ;; (setq new t) | |
384 | ;; (push o dopeners))) | |
385 | ;; (when new | |
386 | ;; (setq done nil) | |
387 | ;; (puthash (cdr k) dopeners openers))))) | |
388 | ;; prec2)) | |
389 | ;; ;; Finally, dump the resulting table. | |
390 | ;; (let ((alist '())) | |
391 | ;; (maphash (lambda (k v) | |
392 | ;; (when (or include-inners (member k closers)) | |
393 | ;; (dolist (opener v) | |
394 | ;; (unless (equal opener k) | |
395 | ;; (push (cons opener k) alist))))) | |
396 | ;; openers) | |
397 | ;; alist))) | |
398 | ||
2ad52c60 | 399 | (defun smie-bnf--closer-alist (bnf &optional no-inners) |
7f925a67 SM |
400 | ;; We can also build this closer-alist table from a prec2 table, |
401 | ;; but it takes more work, and the order is unpredictable, which | |
402 | ;; is a problem for smie-close-block. | |
403 | ;; More convenient would be to build it from a levels table since we | |
404 | ;; always have this table (contrary to the BNF), but it has all the | |
405 | ;; disadvantages of the prec2 case plus the disadvantage that the levels | |
406 | ;; table has lost some info which would result in extra invalid pairs. | |
407 | "Build a closer-alist from a BNF table. | |
408 | The return value is in the same form as `smie-closer-alist'. | |
409 | NO-INNERS if non-nil means that inner keywords will be excluded | |
410 | from the table, e.g. the table will not include things like (\"if\" . \"else\")." | |
411 | (let ((nts (mapcar #'car bnf)) ;non terminals. | |
412 | (alist '())) | |
413 | (dolist (nt bnf) | |
414 | (dolist (rhs (cdr nt)) | |
415 | (unless (or (< (length rhs) 2) (member (car rhs) nts)) | |
416 | (if no-inners | |
417 | (let ((last (car (last rhs)))) | |
418 | (unless (member last nts) | |
f80efb86 | 419 | (cl-pushnew (cons (car rhs) last) alist :test #'equal))) |
7f925a67 SM |
420 | ;; Reverse so that the "real" closer gets there first, |
421 | ;; which is important for smie-close-block. | |
422 | (dolist (term (reverse (cdr rhs))) | |
423 | (unless (member term nts) | |
f80efb86 | 424 | (cl-pushnew (cons (car rhs) term) alist :test #'equal))))))) |
7f925a67 SM |
425 | (nreverse alist))) |
426 | ||
2ad52c60 SM |
427 | (defun smie-bnf--set-class (table token class) |
428 | (let ((prev (gethash token table class))) | |
429 | (puthash token | |
430 | (cond | |
431 | ((eq prev class) class) | |
432 | ((eq prev t) t) ;Non-terminal. | |
433 | (t (display-warning | |
434 | 'smie | |
435 | (format "token %s is both %s and %s" token class prev)) | |
436 | 'neither)) | |
437 | table))) | |
438 | ||
439 | (defun smie-bnf--classify (bnf) | |
7f925a67 | 440 | "Return a table classifying terminals. |
2ad52c60 | 441 | Each terminal can either be an `opener', a `closer', or `neither'." |
7f925a67 SM |
442 | (let ((table (make-hash-table :test #'equal)) |
443 | (alist '())) | |
444 | (dolist (category bnf) | |
2ad52c60 SM |
445 | (puthash (car category) t table)) ;Mark non-terminals. |
446 | (dolist (category bnf) | |
7f925a67 SM |
447 | (dolist (rhs (cdr category)) |
448 | (if (null (cdr rhs)) | |
2ad52c60 SM |
449 | (smie-bnf--set-class table (pop rhs) 'neither) |
450 | (smie-bnf--set-class table (pop rhs) 'opener) | |
451 | (while (cdr rhs) ;Remove internals. | |
452 | (smie-bnf--set-class table (pop rhs) 'neither)) | |
453 | (smie-bnf--set-class table (pop rhs) 'closer)))) | |
7f925a67 SM |
454 | (maphash (lambda (tok v) |
455 | (when (memq v '(closer opener)) | |
456 | (push (cons tok v) alist))) | |
457 | table) | |
458 | alist)) | |
459 | ||
460 | (defun smie-debug--prec2-cycle (csts) | |
461 | "Return a cycle in CSTS, assuming there's one. | |
462 | CSTS is a list of pairs representing arcs in a graph." | |
463 | ;; A PATH is of the form (START . REST) where REST is a reverse | |
464 | ;; list of nodes through which the path goes. | |
465 | (let ((paths (mapcar (lambda (pair) (list (car pair) (cdr pair))) csts)) | |
466 | (cycle nil)) | |
467 | (while (null cycle) | |
468 | (dolist (path (prog1 paths (setq paths nil))) | |
469 | (dolist (cst csts) | |
470 | (when (eq (car cst) (nth 1 path)) | |
471 | (if (eq (cdr cst) (car path)) | |
472 | (setq cycle path) | |
473 | (push (cons (car path) (cons (cdr cst) (cdr path))) | |
474 | paths)))))) | |
475 | (cons (car cycle) (nreverse (cdr cycle))))) | |
476 | ||
477 | (defun smie-debug--describe-cycle (table cycle) | |
478 | (let ((names | |
479 | (mapcar (lambda (val) | |
480 | (let ((res nil)) | |
481 | (dolist (elem table) | |
482 | (if (eq (cdr elem) val) | |
483 | (push (concat "." (car elem)) res)) | |
484 | (if (eq (cddr elem) val) | |
485 | (push (concat (car elem) ".") res))) | |
f80efb86 | 486 | (cl-assert res) |
7f925a67 SM |
487 | res)) |
488 | cycle))) | |
489 | (mapconcat | |
490 | (lambda (elems) (mapconcat 'identity elems "=")) | |
491 | (append names (list (car names))) | |
492 | " < "))) | |
493 | ||
10b40d2e SM |
494 | ;; (defun smie-check-grammar (grammar prec2 &optional dummy) |
495 | ;; (maphash (lambda (k v) | |
496 | ;; (when (consp k) | |
497 | ;; (let ((left (nth 2 (assoc (car k) grammar))) | |
498 | ;; (right (nth 1 (assoc (cdr k) grammar)))) | |
499 | ;; (when (and left right) | |
500 | ;; (cond | |
f80efb86 SM |
501 | ;; ((< left right) (cl-assert (eq v '<))) |
502 | ;; ((> left right) (cl-assert (eq v '>))) | |
503 | ;; (t (cl-assert (eq v '=)))))))) | |
10b40d2e SM |
504 | ;; prec2)) |
505 | ||
7f925a67 SM |
506 | (put 'smie-prec2->grammar 'pure t) |
507 | (defun smie-prec2->grammar (prec2) | |
508 | "Take a 2D precedence table and turn it into an alist of precedence levels. | |
509 | PREC2 is a table as returned by `smie-precs->prec2' or | |
510 | `smie-bnf->prec2'." | |
511 | ;; For each operator, we create two "variables" (corresponding to | |
512 | ;; the left and right precedence level), which are represented by | |
513 | ;; cons cells. Those are the very cons cells that appear in the | |
514 | ;; final `table'. The value of each "variable" is kept in the `car'. | |
515 | (let ((table ()) | |
516 | (csts ()) | |
f80efb86 | 517 | (eqs ())) |
7f925a67 SM |
518 | ;; From `prec2' we construct a list of constraints between |
519 | ;; variables (aka "precedence levels"). These can be either | |
520 | ;; equality constraints (in `eqs') or `<' constraints (in `csts'). | |
521 | (maphash (lambda (k v) | |
522 | (when (consp k) | |
f80efb86 SM |
523 | (let ((tmp (assoc (car k) table)) |
524 | x y) | |
525 | (if tmp | |
526 | (setq x (cddr tmp)) | |
527 | (setq x (cons nil nil)) | |
528 | (push (cons (car k) (cons nil x)) table)) | |
529 | (if (setq tmp (assoc (cdr k) table)) | |
530 | (setq y (cdr tmp)) | |
531 | (setq y (cons nil (cons nil nil))) | |
532 | (push (cons (cdr k) y) table)) | |
533 | (pcase v | |
534 | (`= (push (cons x y) eqs)) | |
535 | (`< (push (cons x y) csts)) | |
536 | (`> (push (cons y x) csts)) | |
537 | (_ (error "SMIE error: prec2 has %S↦%S which ∉ {<,+,>}" | |
538 | k v)))))) | |
7f925a67 SM |
539 | prec2) |
540 | ;; First process the equality constraints. | |
541 | (let ((eqs eqs)) | |
542 | (while eqs | |
543 | (let ((from (caar eqs)) | |
544 | (to (cdar eqs))) | |
545 | (setq eqs (cdr eqs)) | |
546 | (if (eq to from) | |
09ffa822 | 547 | nil ;Nothing to do. |
7f925a67 SM |
548 | (dolist (other-eq eqs) |
549 | (if (eq from (cdr other-eq)) (setcdr other-eq to)) | |
550 | (when (eq from (car other-eq)) | |
551 | ;; This can happen because of `assoc' settings in precs | |
552 | ;; or because of a rhs like ("op" foo "op"). | |
553 | (setcar other-eq to))) | |
554 | (dolist (cst csts) | |
555 | (if (eq from (cdr cst)) (setcdr cst to)) | |
556 | (if (eq from (car cst)) (setcar cst to))))))) | |
557 | ;; Then eliminate trivial constraints iteratively. | |
558 | (let ((i 0)) | |
559 | (while csts | |
560 | (let ((rhvs (mapcar 'cdr csts)) | |
561 | (progress nil)) | |
562 | (dolist (cst csts) | |
563 | (unless (memq (car cst) rhvs) | |
564 | (setq progress t) | |
565 | ;; We could give each var in a given iteration the same value, | |
566 | ;; but we can also give them arbitrarily different values. | |
567 | ;; Basically, these are vars between which there is no | |
568 | ;; constraint (neither equality nor inequality), so | |
569 | ;; anything will do. | |
570 | ;; We give them arbitrary values, which means that we | |
571 | ;; replace the "no constraint" case with either > or < | |
572 | ;; but not =. The reason we do that is so as to try and | |
573 | ;; distinguish associative operators (which will have | |
574 | ;; left = right). | |
575 | (unless (caar cst) | |
576 | (setcar (car cst) i) | |
10b40d2e | 577 | ;; (smie-check-grammar table prec2 'step1) |
f80efb86 | 578 | (cl-incf i)) |
7f925a67 SM |
579 | (setq csts (delq cst csts)))) |
580 | (unless progress | |
581 | (error "Can't resolve the precedence cycle: %s" | |
582 | (smie-debug--describe-cycle | |
583 | table (smie-debug--prec2-cycle csts))))) | |
f80efb86 | 584 | (cl-incf i 10)) |
e4769531 | 585 | ;; Propagate equality constraints back to their sources. |
7f925a67 | 586 | (dolist (eq (nreverse eqs)) |
10b40d2e SM |
587 | (when (null (cadr eq)) |
588 | ;; There's an equality constraint, but we still haven't given | |
589 | ;; it a value: that means it binds tighter than anything else, | |
590 | ;; and it can't be an opener/closer (those don't have equality | |
591 | ;; constraints). | |
592 | ;; So set it here rather than below since doing it below | |
593 | ;; makes it more difficult to obey the equality constraints. | |
594 | (setcar (cdr eq) i) | |
f80efb86 SM |
595 | (cl-incf i)) |
596 | (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) | |
10b40d2e SM |
597 | (setcar (car eq) (cadr eq)) |
598 | ;; (smie-check-grammar table prec2 'step2) | |
599 | ) | |
09ffa822 SM |
600 | ;; Finally, fill in the remaining vars (which did not appear on the |
601 | ;; left side of any < constraint). | |
602 | (dolist (x table) | |
603 | (unless (nth 1 x) | |
2ee3d7f0 | 604 | (setf (nth 1 x) i) |
f80efb86 | 605 | (cl-incf i)) ;See other (cl-incf i) above. |
09ffa822 | 606 | (unless (nth 2 x) |
2ee3d7f0 | 607 | (setf (nth 2 x) i) |
f80efb86 | 608 | (cl-incf i)))) ;See other (cl-incf i) above. |
09ffa822 SM |
609 | ;; Mark closers and openers. |
610 | (dolist (x (gethash :smie-open/close-alist prec2)) | |
611 | (let* ((token (car x)) | |
f80efb86 SM |
612 | (cons (pcase (cdr x) |
613 | (`closer (cddr (assoc token table))) | |
614 | (`opener (cdr (assoc token table)))))) | |
615 | (cl-assert (numberp (car cons))) | |
2ee3d7f0 | 616 | (setf (car cons) (list (car cons))))) |
7f925a67 SM |
617 | (let ((ca (gethash :smie-closer-alist prec2))) |
618 | (when ca (push (cons :smie-closer-alist ca) table))) | |
10b40d2e | 619 | ;; (smie-check-grammar table prec2 'step3) |
7f925a67 SM |
620 | table)) |
621 | ||
622 | ;;; Parsing using a precedence level table. | |
623 | ||
624 | (defvar smie-grammar 'unset | |
625 | "List of token parsing info. | |
626 | This list is normally built by `smie-prec2->grammar'. | |
627 | Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL). | |
628 | Parsing is done using an operator precedence parser. | |
e2f454c4 | 629 | LEFT-LEVEL and RIGHT-LEVEL can be either numbers or a list, where a list |
7f925a67 | 630 | means that this operator does not bind on the corresponding side, |
e2f454c4 | 631 | e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like |
7f925a67 SM |
632 | an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something |
633 | like a close-paren.") | |
634 | ||
635 | (defvar smie-forward-token-function 'smie-default-forward-token | |
636 | "Function to scan forward for the next token. | |
637 | Called with no argument should return a token and move to its end. | |
638 | If no token is found, return nil or the empty string. | |
639 | It can return nil when bumping into a parenthesis, which lets SMIE | |
640 | use syntax-tables to handle them in efficient C code.") | |
641 | ||
642 | (defvar smie-backward-token-function 'smie-default-backward-token | |
643 | "Function to scan backward the previous token. | |
644 | Same calling convention as `smie-forward-token-function' except | |
645 | it should move backward to the beginning of the previous token.") | |
646 | ||
647 | (defalias 'smie-op-left 'car) | |
648 | (defalias 'smie-op-right 'cadr) | |
649 | ||
650 | (defun smie-default-backward-token () | |
651 | (forward-comment (- (point))) | |
652 | (buffer-substring-no-properties | |
653 | (point) | |
654 | (progn (if (zerop (skip-syntax-backward ".")) | |
655 | (skip-syntax-backward "w_'")) | |
656 | (point)))) | |
657 | ||
658 | (defun smie-default-forward-token () | |
659 | (forward-comment (point-max)) | |
660 | (buffer-substring-no-properties | |
661 | (point) | |
662 | (progn (if (zerop (skip-syntax-forward ".")) | |
663 | (skip-syntax-forward "w_'")) | |
664 | (point)))) | |
665 | ||
666 | (defun smie--associative-p (toklevels) | |
667 | ;; in "a + b + c" we want to stop at each +, but in | |
668 | ;; "if a then b elsif c then d else c" we don't want to stop at each keyword. | |
669 | ;; To distinguish the two cases, we made smie-prec2->grammar choose | |
670 | ;; different levels for each part of "if a then b else c", so that | |
671 | ;; by checking if the left-level is equal to the right level, we can | |
672 | ;; figure out that it's an associative operator. | |
673 | ;; This is not 100% foolproof, tho, since the "elsif" will have to have | |
674 | ;; equal left and right levels (since it's optional), so smie-next-sexp | |
675 | ;; has to be careful to distinguish those different cases. | |
676 | (eq (smie-op-left toklevels) (smie-op-right toklevels))) | |
677 | ||
678 | (defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp) | |
679 | "Skip over one sexp. | |
680 | NEXT-TOKEN is a function of no argument that moves forward by one | |
681 | token (after skipping comments if needed) and returns it. | |
682 | NEXT-SEXP is a lower-level function to skip one sexp. | |
683 | OP-FORW is the accessor to the forward level of the level data. | |
684 | OP-BACK is the accessor to the backward level of the level data. | |
685 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the | |
686 | first token we see is an operator, skip over its left-hand-side argument. | |
09ffa822 SM |
687 | HALFSEXP can also be a token, in which case it means to parse as if |
688 | we had just successfully passed this token. | |
7f925a67 SM |
689 | Possible return values: |
690 | (FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level | |
691 | is too high. FORW-LEVEL is the forw-level of TOKEN, | |
692 | POS is its start position in the buffer. | |
693 | (t POS TOKEN): same thing when we bump on the wrong side of a paren. | |
fdb058c2 | 694 | Instead of t, the `car' can also be some other non-nil non-number value. |
7f925a67 SM |
695 | (nil POS TOKEN): we skipped over a paren-like pair. |
696 | nil: we skipped over an identifier, matched parentheses, ..." | |
697 | (catch 'return | |
09ffa822 SM |
698 | (let ((levels |
699 | (if (stringp halfsexp) | |
700 | (prog1 (list (cdr (assoc halfsexp smie-grammar))) | |
701 | (setq halfsexp nil))))) | |
7f925a67 SM |
702 | (while |
703 | (let* ((pos (point)) | |
704 | (token (funcall next-token)) | |
705 | (toklevels (cdr (assoc token smie-grammar)))) | |
706 | (cond | |
707 | ((null toklevels) | |
708 | (when (zerop (length token)) | |
709 | (condition-case err | |
34d1a133 | 710 | (progn (funcall next-sexp 1) nil) |
dc5d230c | 711 | (scan-error |
d2e0e795 SM |
712 | (let ((epos (nth 2 err))) |
713 | (goto-char pos) | |
dc5d230c | 714 | (throw 'return |
d2e0e795 | 715 | (list t epos |
dc5d230c | 716 | (buffer-substring-no-properties |
d2e0e795 SM |
717 | epos |
718 | (+ epos (if (< (point) epos) -1 1)))))))) | |
7f925a67 SM |
719 | (if (eq pos (point)) |
720 | ;; We did not move, so let's abort the loop. | |
721 | (throw 'return (list t (point)))))) | |
e2f454c4 | 722 | ((not (numberp (funcall op-back toklevels))) |
7f925a67 | 723 | ;; A token like a paren-close. |
f80efb86 SM |
724 | (cl-assert (numberp ; Otherwise, why mention it in smie-grammar. |
725 | (funcall op-forw toklevels))) | |
7f925a67 SM |
726 | (push toklevels levels)) |
727 | (t | |
728 | (while (and levels (< (funcall op-back toklevels) | |
729 | (funcall op-forw (car levels)))) | |
730 | (setq levels (cdr levels))) | |
731 | (cond | |
732 | ((null levels) | |
e2f454c4 | 733 | (if (and halfsexp (numberp (funcall op-forw toklevels))) |
7f925a67 SM |
734 | (push toklevels levels) |
735 | (throw 'return | |
06bc5e6e SM |
736 | (prog1 (list (or (funcall op-forw toklevels) t) |
737 | (point) token) | |
7f925a67 SM |
738 | (goto-char pos))))) |
739 | (t | |
740 | (let ((lastlevels levels)) | |
741 | (if (and levels (= (funcall op-back toklevels) | |
742 | (funcall op-forw (car levels)))) | |
743 | (setq levels (cdr levels))) | |
744 | ;; We may have found a match for the previously pending | |
745 | ;; operator. Is this the end? | |
746 | (cond | |
747 | ;; Keep looking as long as we haven't matched the | |
748 | ;; topmost operator. | |
749 | (levels | |
2ad52c60 SM |
750 | (cond |
751 | ((numberp (funcall op-forw toklevels)) | |
752 | (push toklevels levels)) | |
753 | ;; FIXME: For some languages, we can express the grammar | |
754 | ;; OK, but next-sexp doesn't stop where we'd want it to. | |
755 | ;; E.g. in SML, we'd want to stop right in front of | |
756 | ;; "local" if we're scanning (both forward and backward) | |
757 | ;; from a "val/fun/..." at the same level. | |
758 | ;; Same for Pascal/Modula2's "procedure" w.r.t | |
759 | ;; "type/var/const". | |
760 | ;; | |
761 | ;; ((and (functionp (cadr (funcall op-forw toklevels))) | |
762 | ;; (funcall (cadr (funcall op-forw toklevels)) | |
763 | ;; levels)) | |
764 | ;; (setq levels nil)) | |
765 | )) | |
7f925a67 SM |
766 | ;; We matched the topmost operator. If the new operator |
767 | ;; is the last in the corresponding BNF rule, we're done. | |
e2f454c4 | 768 | ((not (numberp (funcall op-forw toklevels))) |
7f925a67 SM |
769 | ;; It is the last element, let's stop here. |
770 | (throw 'return (list nil (point) token))) | |
771 | ;; If the new operator is not the last in the BNF rule, | |
7bea8c7a | 772 | ;; and is not associative, it's one of the inner operators |
7f925a67 SM |
773 | ;; (like the "in" in "let .. in .. end"), so keep looking. |
774 | ((not (smie--associative-p toklevels)) | |
775 | (push toklevels levels)) | |
776 | ;; The new operator is associative. Two cases: | |
777 | ;; - it's really just an associative operator (like + or ;) | |
778 | ;; in which case we should have stopped right before. | |
779 | ((and lastlevels | |
780 | (smie--associative-p (car lastlevels))) | |
781 | (throw 'return | |
06bc5e6e SM |
782 | (prog1 (list (or (funcall op-forw toklevels) t) |
783 | (point) token) | |
7f925a67 SM |
784 | (goto-char pos)))) |
785 | ;; - it's an associative operator within a larger construct | |
786 | ;; (e.g. an "elsif"), so we should just ignore it and keep | |
787 | ;; looking for the closing element. | |
788 | (t (setq levels lastlevels)))))))) | |
789 | levels) | |
790 | (setq halfsexp nil))))) | |
791 | ||
792 | (defun smie-backward-sexp (&optional halfsexp) | |
793 | "Skip over one sexp. | |
794 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the | |
795 | first token we see is an operator, skip over its left-hand-side argument. | |
09ffa822 SM |
796 | HALFSEXP can also be a token, in which case we should skip the text |
797 | assuming it is the left-hand-side argument of that token. | |
7f925a67 SM |
798 | Possible return values: |
799 | (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level | |
800 | is too high. LEFT-LEVEL is the left-level of TOKEN, | |
801 | POS is its start position in the buffer. | |
802 | (t POS TOKEN): same thing but for an open-paren or the beginning of buffer. | |
fdb058c2 | 803 | Instead of t, the `car' can also be some other non-nil non-number value. |
7f925a67 SM |
804 | (nil POS TOKEN): we skipped over a paren-like pair. |
805 | nil: we skipped over an identifier, matched parentheses, ..." | |
806 | (smie-next-sexp | |
807 | (indirect-function smie-backward-token-function) | |
808 | (indirect-function 'backward-sexp) | |
809 | (indirect-function 'smie-op-left) | |
810 | (indirect-function 'smie-op-right) | |
811 | halfsexp)) | |
812 | ||
813 | (defun smie-forward-sexp (&optional halfsexp) | |
814 | "Skip over one sexp. | |
815 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the | |
09ffa822 SM |
816 | first token we see is an operator, skip over its right-hand-side argument. |
817 | HALFSEXP can also be a token, in which case we should skip the text | |
818 | assuming it is the right-hand-side argument of that token. | |
7f925a67 SM |
819 | Possible return values: |
820 | (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level | |
821 | is too high. RIGHT-LEVEL is the right-level of TOKEN, | |
822 | POS is its end position in the buffer. | |
fdb058c2 SM |
823 | (t POS TOKEN): same thing but for a close-paren or the end of buffer. |
824 | Instead of t, the `car' can also be some other non-nil non-number value. | |
7f925a67 SM |
825 | (nil POS TOKEN): we skipped over a paren-like pair. |
826 | nil: we skipped over an identifier, matched parentheses, ..." | |
827 | (smie-next-sexp | |
828 | (indirect-function smie-forward-token-function) | |
829 | (indirect-function 'forward-sexp) | |
830 | (indirect-function 'smie-op-right) | |
831 | (indirect-function 'smie-op-left) | |
832 | halfsexp)) | |
833 | ||
09e80d9f | 834 | ;;; Miscellaneous commands using the precedence parser. |
7f925a67 SM |
835 | |
836 | (defun smie-backward-sexp-command (&optional n) | |
837 | "Move backward through N logical elements." | |
838 | (interactive "^p") | |
839 | (smie-forward-sexp-command (- n))) | |
840 | ||
841 | (defun smie-forward-sexp-command (&optional n) | |
842 | "Move forward through N logical elements." | |
843 | (interactive "^p") | |
844 | (let ((forw (> n 0)) | |
845 | (forward-sexp-function nil)) | |
846 | (while (/= n 0) | |
847 | (setq n (- n (if forw 1 -1))) | |
848 | (let ((pos (point)) | |
849 | (res (if forw | |
850 | (smie-forward-sexp 'halfsexp) | |
851 | (smie-backward-sexp 'halfsexp)))) | |
852 | (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp)))) | |
853 | (signal 'scan-error | |
854 | (list "Containing expression ends prematurely" | |
855 | (cadr res) (cadr res))) | |
856 | nil))))) | |
857 | ||
858 | (defvar smie-closer-alist nil | |
859 | "Alist giving the closer corresponding to an opener.") | |
860 | ||
861 | (defun smie-close-block () | |
862 | "Close the closest surrounding block." | |
863 | (interactive) | |
864 | (let ((closer | |
865 | (save-excursion | |
866 | (backward-up-list 1) | |
867 | (if (looking-at "\\s(") | |
868 | (string (cdr (syntax-after (point)))) | |
869 | (let* ((open (funcall smie-forward-token-function)) | |
870 | (closer (cdr (assoc open smie-closer-alist))) | |
871 | (levels (list (assoc open smie-grammar))) | |
872 | (seen '()) | |
873 | (found '())) | |
874 | (cond | |
875 | ;; Even if we improve the auto-computation of closers, | |
876 | ;; there are still cases where we need manual | |
877 | ;; intervention, e.g. for Octave's use of `until' | |
878 | ;; as a pseudo-closer of `do'. | |
879 | (closer) | |
e2f454c4 | 880 | ((or (equal levels '(nil)) (numberp (nth 1 (car levels)))) |
7f925a67 SM |
881 | (error "Doesn't look like a block")) |
882 | (t | |
883 | ;; Now that smie-setup automatically sets smie-closer-alist | |
884 | ;; from the BNF, this is not really needed any more. | |
885 | (while levels | |
886 | (let ((level (pop levels))) | |
887 | (dolist (other smie-grammar) | |
888 | (when (and (eq (nth 2 level) (nth 1 other)) | |
889 | (not (memq other seen))) | |
890 | (push other seen) | |
e2f454c4 | 891 | (if (numberp (nth 2 other)) |
7f925a67 SM |
892 | (push other levels) |
893 | (push (car other) found)))))) | |
894 | (cond | |
895 | ((null found) (error "No known closer for opener %s" open)) | |
09ffa822 | 896 | ;; What should we do if there are various closers? |
7f925a67 SM |
897 | (t (car found)))))))))) |
898 | (unless (save-excursion (skip-chars-backward " \t") (bolp)) | |
899 | (newline)) | |
900 | (insert closer) | |
901 | (if (save-excursion (skip-chars-forward " \t") (eolp)) | |
902 | (indent-according-to-mode) | |
903 | (reindent-then-newline-and-indent)))) | |
904 | ||
905 | (defun smie-down-list (&optional arg) | |
906 | "Move forward down one level paren-like blocks. Like `down-list'. | |
907 | With argument ARG, do this that many times. | |
908 | A negative argument means move backward but still go down a level. | |
909 | This command assumes point is not in a string or comment." | |
910 | (interactive "p") | |
911 | (let ((start (point)) | |
912 | (inc (if (< arg 0) -1 1)) | |
913 | (offset (if (< arg 0) 1 0)) | |
914 | (next-token (if (< arg 0) | |
915 | smie-backward-token-function | |
916 | smie-forward-token-function))) | |
917 | (while (/= arg 0) | |
918 | (setq arg (- arg inc)) | |
919 | (while | |
920 | (let* ((pos (point)) | |
921 | (token (funcall next-token)) | |
922 | (levels (assoc token smie-grammar))) | |
923 | (cond | |
924 | ((zerop (length token)) | |
925 | (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point))) | |
926 | (looking-at "\\s(\\|\\s)")) | |
927 | ;; Go back to `start' in case of an error. This presumes | |
928 | ;; none of the token we've found until now include a ( or ). | |
929 | (progn (goto-char start) (down-list inc) nil) | |
930 | (forward-sexp inc) | |
931 | (/= (point) pos))) | |
e2f454c4 SM |
932 | ((and levels (not (numberp (nth (+ 1 offset) levels)))) nil) |
933 | ((and levels (not (numberp (nth (- 2 offset) levels)))) | |
7f925a67 SM |
934 | (let ((end (point))) |
935 | (goto-char start) | |
936 | (signal 'scan-error | |
937 | (list "Containing expression ends prematurely" | |
938 | pos end)))) | |
939 | (t))))))) | |
940 | ||
941 | (defvar smie-blink-matching-triggers '(?\s ?\n) | |
942 | "Chars which might trigger `blink-matching-open'. | |
943 | These can include the final chars of end-tokens, or chars that are | |
944 | typically inserted right after an end token. | |
945 | I.e. a good choice can be: | |
946 | (delete-dups | |
947 | (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw))))) | |
948 | smie-closer-alist))") | |
949 | ||
950 | (defcustom smie-blink-matching-inners t | |
951 | "Whether SMIE should blink to matching opener for inner keywords. | |
952 | If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." | |
953 | :type 'boolean | |
954 | :group 'smie) | |
955 | ||
956 | (defun smie-blink-matching-check (start end) | |
957 | (save-excursion | |
958 | (goto-char end) | |
959 | (let ((ender (funcall smie-backward-token-function))) | |
960 | (cond | |
961 | ((not (and ender (rassoc ender smie-closer-alist))) | |
544badc3 | 962 | ;; This is not one of the begin..end we know how to check. |
7f925a67 SM |
963 | (blink-matching-check-mismatch start end)) |
964 | ((not start) t) | |
965 | ((eq t (car (rassoc ender smie-closer-alist))) nil) | |
966 | (t | |
967 | (goto-char start) | |
968 | (let ((starter (funcall smie-forward-token-function))) | |
969 | (not (member (cons starter ender) smie-closer-alist)))))))) | |
970 | ||
971 | (defun smie-blink-matching-open () | |
972 | "Blink the matching opener when applicable. | |
973 | This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." | |
974 | (let ((pos (point)) ;Position after the close token. | |
975 | token) | |
976 | (when (and blink-matching-paren | |
977 | smie-closer-alist ; Optimization. | |
978 | (or (eq (char-before) last-command-event) ;; Sanity check. | |
979 | (save-excursion | |
980 | (or (progn (skip-chars-backward " \t") | |
981 | (setq pos (point)) | |
982 | (eq (char-before) last-command-event)) | |
983 | (progn (skip-chars-backward " \n\t") | |
984 | (setq pos (point)) | |
985 | (eq (char-before) last-command-event))))) | |
986 | (memq last-command-event smie-blink-matching-triggers) | |
987 | (not (nth 8 (syntax-ppss)))) | |
988 | (save-excursion | |
989 | (setq token (funcall smie-backward-token-function)) | |
990 | (when (and (eq (point) (1- pos)) | |
991 | (= 1 (length token)) | |
992 | (not (rassoc token smie-closer-alist))) | |
993 | ;; The trigger char is itself a token but is not one of the | |
994 | ;; closers (e.g. ?\; in Octave mode), so go back to the | |
995 | ;; previous token. | |
996 | (setq pos (point)) | |
997 | (setq token (funcall smie-backward-token-function))) | |
998 | (when (rassoc token smie-closer-alist) | |
999 | ;; We're after a close token. Let's still make sure we | |
1000 | ;; didn't skip a comment to find that token. | |
1001 | (funcall smie-forward-token-function) | |
1002 | (when (and (save-excursion | |
1003 | ;; Skip the trigger char, if applicable. | |
1004 | (if (eq (char-after) last-command-event) | |
1005 | (forward-char 1)) | |
1006 | (if (eq ?\n last-command-event) | |
1007 | ;; Skip any auto-indentation, if applicable. | |
1008 | (skip-chars-forward " \t")) | |
1009 | (>= (point) pos)) | |
1010 | ;; If token ends with a trigger char, don't blink for | |
1011 | ;; anything else than this trigger char, lest we'd blink | |
1012 | ;; both when inserting the trigger char and when | |
1013 | ;; inserting a subsequent trigger char like SPC. | |
9517f8af | 1014 | (or (eq (char-before) last-command-event) |
7f925a67 SM |
1015 | (not (memq (char-before) |
1016 | smie-blink-matching-triggers))) | |
544badc3 SM |
1017 | ;; FIXME: For octave's "switch ... case ... case" we flash |
1018 | ;; `switch' at the end of the first `case' and we burp | |
1019 | ;; "mismatch" at the end of the second `case'. | |
7f925a67 | 1020 | (or smie-blink-matching-inners |
e2f454c4 | 1021 | (not (numberp (nth 2 (assoc token smie-grammar)))))) |
7f925a67 SM |
1022 | ;; The major mode might set blink-matching-check-function |
1023 | ;; buffer-locally so that interactive calls to | |
1024 | ;; blink-matching-open work right, but let's not presume | |
1025 | ;; that's the case. | |
1026 | (let ((blink-matching-check-function #'smie-blink-matching-check)) | |
1027 | (blink-matching-open)))))))) | |
1028 | ||
976cb066 LL |
1029 | (defvar-local smie--matching-block-data-cache nil) |
1030 | ||
544badc3 SM |
1031 | (defun smie--opener/closer-at-point () |
1032 | "Return (OPENER TOKEN START END) or nil. | |
1033 | OPENER is non-nil if TOKEN is an opener and nil if it's a closer." | |
1034 | (let* ((start (point)) | |
1035 | ;; Move to a previous position outside of a token. | |
1036 | (_ (funcall smie-backward-token-function)) | |
1037 | ;; Move to the end of the token before point. | |
1038 | (btok (funcall smie-forward-token-function)) | |
1039 | (bend (point))) | |
1040 | (cond | |
1041 | ;; Token before point is a closer? | |
1042 | ((and (>= bend start) (rassoc btok smie-closer-alist)) | |
1043 | (funcall smie-backward-token-function) | |
1044 | (when (< (point) start) | |
1045 | (prog1 (list nil btok (point) bend) | |
1046 | (goto-char bend)))) | |
1047 | ;; Token around point is an opener? | |
1048 | ((and (> bend start) (assoc btok smie-closer-alist)) | |
1049 | (funcall smie-backward-token-function) | |
1050 | (when (<= (point) start) (list t btok (point) bend))) | |
1051 | ((<= bend start) | |
1052 | (let ((atok (funcall smie-forward-token-function)) | |
1053 | (aend (point))) | |
1054 | (cond | |
1055 | ((< aend start) nil) ;Hopefully shouldn't happen. | |
1056 | ;; Token after point is a closer? | |
1057 | ((assoc atok smie-closer-alist) | |
1058 | (funcall smie-backward-token-function) | |
1059 | (when (<= (point) start) | |
1060 | (list t atok (point) aend))))))))) | |
1061 | ||
976cb066 LL |
1062 | (defun smie--matching-block-data (orig &rest args) |
1063 | "A function suitable for `show-paren-data-function' (which see)." | |
544badc3 | 1064 | (if (or (null smie-closer-alist) |
0922b826 DG |
1065 | (equal (cons (point) (buffer-chars-modified-tick)) |
1066 | (car smie--matching-block-data-cache))) | |
544badc3 SM |
1067 | (or (cdr smie--matching-block-data-cache) |
1068 | (apply orig args)) | |
0922b826 DG |
1069 | (setq smie--matching-block-data-cache |
1070 | (list (cons (point) (buffer-chars-modified-tick)))) | |
544badc3 SM |
1071 | (unless (nth 8 (syntax-ppss)) |
1072 | (condition-case nil | |
1073 | (let ((here (smie--opener/closer-at-point))) | |
1074 | (when (and here | |
1075 | (or smie-blink-matching-inners | |
1076 | (not (numberp | |
1077 | (nth (if (nth 0 here) 1 2) | |
1078 | (assoc (nth 1 here) smie-grammar)))))) | |
1079 | (let ((there | |
1080 | (cond | |
1081 | ((car here) ; Opener. | |
1082 | (let ((data (smie-forward-sexp 'halfsexp)) | |
1083 | (tend (point))) | |
1084 | (unless (car data) | |
1085 | (funcall smie-backward-token-function) | |
1086 | (list (member (cons (nth 1 here) (nth 2 data)) | |
1087 | smie-closer-alist) | |
1088 | (point) tend)))) | |
1089 | (t ;Closer. | |
1090 | (let ((data (smie-backward-sexp 'halfsexp)) | |
1091 | (htok (nth 1 here))) | |
1092 | (if (car data) | |
1093 | (let* ((hprec (nth 2 (assoc htok smie-grammar))) | |
1094 | (ttok (nth 2 data)) | |
1095 | (tprec (nth 1 (assoc ttok smie-grammar)))) | |
1096 | (when (and (numberp hprec) ;Here is an inner. | |
1097 | (eq hprec tprec)) | |
1098 | (goto-char (nth 1 data)) | |
1099 | (let ((tbeg (point))) | |
1100 | (funcall smie-forward-token-function) | |
1101 | (list t tbeg (point))))) | |
1102 | (let ((tbeg (point))) | |
1103 | (funcall smie-forward-token-function) | |
1104 | (list (member (cons (nth 2 data) htok) | |
1105 | smie-closer-alist) | |
1106 | tbeg (point))))))))) | |
1107 | ;; Update the cache. | |
1108 | (setcdr smie--matching-block-data-cache | |
1109 | (list (nth 2 here) (nth 3 here) | |
1110 | (nth 1 there) (nth 2 there) | |
1111 | (not (nth 0 there))))))) | |
1112 | (scan-error nil)) | |
0922b826 | 1113 | (goto-char (caar smie--matching-block-data-cache))) |
544badc3 | 1114 | (apply #'smie--matching-block-data orig args))) |
ebfe68e8 | 1115 | |
7f925a67 SM |
1116 | ;;; The indentation engine. |
1117 | ||
1118 | (defcustom smie-indent-basic 4 | |
1119 | "Basic amount of indentation." | |
1120 | :type 'integer | |
1121 | :group 'smie) | |
1122 | ||
1123 | (defvar smie-rules-function 'ignore | |
1124 | "Function providing the indentation rules. | |
1125 | It takes two arguments METHOD and ARG where the meaning of ARG | |
1126 | and the expected return value depends on METHOD. | |
1127 | METHOD can be: | |
1128 | - :after, in which case ARG is a token and the function should return the | |
1129 | OFFSET to use for indentation after ARG. | |
1130 | - :before, in which case ARG is a token and the function should return the | |
1131 | OFFSET to use to indent ARG itself. | |
1132 | - :elem, in which case the function should return either: | |
1133 | - the offset to use to indent function arguments (ARG = `arg') | |
1134 | - the basic indentation step (ARG = `basic'). | |
1135 | - :list-intro, in which case ARG is a token and the function should return | |
1136 | non-nil if TOKEN is followed by a list of expressions (not separated by any | |
1137 | token) rather than an expression. | |
5556c0ce DG |
1138 | - :close-all, in which case ARG is a close-paren token at indentation and |
1139 | the function should return non-nil if it should be aligned with the opener | |
1140 | of the last close-paren token on the same line, if there are multiple. | |
1141 | Otherwise, it will be aligned with its own opener. | |
7f925a67 SM |
1142 | |
1143 | When ARG is a token, the function is called with point just before that token. | |
1144 | A return value of nil always means to fallback on the default behavior, so the | |
1145 | function should return nil for arguments it does not expect. | |
1146 | ||
1147 | OFFSET can be: | |
1148 | nil use the default indentation rule. | |
2ad52c60 | 1149 | \(column . COLUMN) indent to column COLUMN. |
7f925a67 SM |
1150 | NUMBER offset by NUMBER, relative to a base token |
1151 | which is the current token for :after and | |
1152 | its parent for :before. | |
1153 | ||
1154 | The functions whose name starts with \"smie-rule-\" are helper functions | |
1155 | designed specifically for use in this function.") | |
1156 | ||
1157 | (defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) | |
1158 | (defun smie-indent--hanging-p () | |
1159 | "Return non-nil if the current token is \"hanging\". | |
1160 | A hanging keyword is one that's at the end of a line except it's not at | |
1161 | the beginning of a line." | |
1162 | (and (not (smie-indent--bolp)) | |
1163 | (save-excursion | |
1164 | (<= (line-end-position) | |
1165 | (progn | |
ced3fc5d SM |
1166 | (and (zerop (length (funcall smie-forward-token-function))) |
1167 | (not (eobp)) | |
1168 | ;; Could be an open-paren. | |
1169 | (forward-char 1)) | |
7f925a67 SM |
1170 | (skip-chars-forward " \t") |
1171 | (or (eolp) | |
7ae3ae39 | 1172 | (and ;; (looking-at comment-start-skip) ;(bug#16041). |
7f925a67 SM |
1173 | (forward-comment (point-max)))) |
1174 | (point)))))) | |
1175 | ||
1176 | (defalias 'smie-rule-bolp 'smie-indent--bolp) | |
1177 | (defun smie-indent--bolp () | |
1178 | "Return non-nil if the current token is the first on the line." | |
1179 | (save-excursion (skip-chars-backward " \t") (bolp))) | |
1180 | ||
fdb058c2 SM |
1181 | (defun smie-indent--bolp-1 () |
1182 | ;; Like smie-indent--bolp but also returns non-nil if it's the first | |
1183 | ;; non-comment token. Maybe we should simply always use this? | |
1184 | "Return non-nil if the current token is the first on the line. | |
1185 | Comments are treated as spaces." | |
1186 | (let ((bol (line-beginning-position))) | |
1187 | (save-excursion | |
1188 | (forward-comment (- (point))) | |
1189 | (<= (point) bol)))) | |
1190 | ||
7f925a67 SM |
1191 | ;; Dynamically scoped. |
1192 | (defvar smie--parent) (defvar smie--after) (defvar smie--token) | |
1193 | ||
1194 | (defun smie-indent--parent () | |
1195 | (or smie--parent | |
1196 | (save-excursion | |
1197 | (let* ((pos (point)) | |
1198 | (tok (funcall smie-forward-token-function))) | |
e2f454c4 | 1199 | (unless (numberp (cadr (assoc tok smie-grammar))) |
7f925a67 SM |
1200 | (goto-char pos)) |
1201 | (setq smie--parent | |
9517f8af SM |
1202 | (or (smie-backward-sexp 'halfsexp) |
1203 | (let (res) | |
1204 | (while (null (setq res (smie-backward-sexp)))) | |
1205 | (list nil (point) (nth 2 res))))))))) | |
7f925a67 SM |
1206 | |
1207 | (defun smie-rule-parent-p (&rest parents) | |
1208 | "Return non-nil if the current token's parent is among PARENTS. | |
1209 | Only meaningful when called from within `smie-rules-function'." | |
1210 | (member (nth 2 (smie-indent--parent)) parents)) | |
1211 | ||
1212 | (defun smie-rule-next-p (&rest tokens) | |
1213 | "Return non-nil if the next token is among TOKENS. | |
1214 | Only meaningful when called from within `smie-rules-function'." | |
1215 | (let ((next | |
1216 | (save-excursion | |
1217 | (unless smie--after | |
1218 | (smie-indent-forward-token) (setq smie--after (point))) | |
1219 | (goto-char smie--after) | |
1220 | (smie-indent-forward-token)))) | |
1221 | (member (car next) tokens))) | |
1222 | ||
1223 | (defun smie-rule-prev-p (&rest tokens) | |
1224 | "Return non-nil if the previous token is among TOKENS." | |
1225 | (let ((prev (save-excursion | |
1226 | (smie-indent-backward-token)))) | |
1227 | (member (car prev) tokens))) | |
1228 | ||
1229 | (defun smie-rule-sibling-p () | |
1230 | "Return non-nil if the parent is actually a sibling. | |
1231 | Only meaningful when called from within `smie-rules-function'." | |
1232 | (eq (car (smie-indent--parent)) | |
1233 | (cadr (assoc smie--token smie-grammar)))) | |
1234 | ||
1235 | (defun smie-rule-parent (&optional offset) | |
1236 | "Align with parent. | |
1237 | If non-nil, OFFSET should be an integer giving an additional offset to apply. | |
1238 | Only meaningful when called from within `smie-rules-function'." | |
1239 | (save-excursion | |
1240 | (goto-char (cadr (smie-indent--parent))) | |
1241 | (cons 'column | |
1242 | (+ (or offset 0) | |
e61845c1 | 1243 | (smie-indent-virtual))))) |
7f925a67 SM |
1244 | |
1245 | (defvar smie-rule-separator-outdent 2) | |
1246 | ||
1247 | (defun smie-indent--separator-outdent () | |
1248 | ;; FIXME: Here we actually have several reasonable behaviors. | |
1249 | ;; E.g. for a parent token of "FOO" and a separator ";" we may want to: | |
1250 | ;; 1- left-align ; with FOO. | |
1251 | ;; 2- right-align ; with FOO. | |
1252 | ;; 3- align content after ; with content after FOO. | |
1253 | ;; 4- align content plus add/remove spaces so as to align ; with FOO. | |
1254 | ;; Currently, we try to align the contents (option 3) which actually behaves | |
1255 | ;; just like option 2 (if the number of spaces after FOO and ; is equal). | |
1256 | (let ((afterpos (save-excursion | |
1257 | (let ((tok (funcall smie-forward-token-function))) | |
1258 | (unless tok | |
1259 | (with-demoted-errors | |
1260 | (error "smie-rule-separator: can't skip token %s" | |
1261 | smie--token)))) | |
1262 | (skip-chars-forward " ") | |
1263 | (unless (eolp) (point))))) | |
1264 | (or (and afterpos | |
1265 | ;; This should always be true, unless | |
1266 | ;; smie-forward-token-function skipped a \n. | |
1267 | (< afterpos (line-end-position)) | |
1268 | (- afterpos (point))) | |
1269 | smie-rule-separator-outdent))) | |
1270 | ||
1271 | (defun smie-rule-separator (method) | |
1272 | "Indent current token as a \"separator\". | |
1273 | By \"separator\", we mean here a token whose sole purpose is to separate | |
1274 | various elements within some enclosing syntactic construct, and which does | |
1275 | not have any semantic significance in itself (i.e. it would typically no exist | |
1276 | as a node in an abstract syntax tree). | |
1277 | Such a token is expected to have an associative syntax and be closely tied | |
1278 | to its syntactic parent. Typical examples are \",\" in lists of arguments | |
1279 | \(enclosed inside parentheses), or \";\" in sequences of instructions (enclosed | |
1280 | in a {..} or begin..end block). | |
1281 | METHOD should be the method name that was passed to `smie-rules-function'. | |
1282 | Only meaningful when called from within `smie-rules-function'." | |
1283 | ;; FIXME: The code below works OK for cases where the separators | |
1284 | ;; are placed consistently always at beginning or always at the end, | |
1285 | ;; but not if some are at the beginning and others are at the end. | |
1286 | ;; I.e. it gets confused in cases such as: | |
1287 | ;; ( a | |
1288 | ;; , a, | |
1289 | ;; b | |
1290 | ;; , c, | |
1291 | ;; d | |
1292 | ;; ) | |
1293 | ;; | |
1294 | ;; Assuming token is associative, the default rule for associative | |
1295 | ;; tokens (which assumes an infix operator) works fine for many cases. | |
1296 | ;; We mostly need to take care of the case where token is at beginning of | |
1297 | ;; line, in which case we want to align it with its enclosing parent. | |
1298 | (cond | |
1299 | ((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p))) | |
7bea8c7a | 1300 | (let ((parent-col (cdr (smie-rule-parent))) |
7f925a67 SM |
1301 | (parent-pos-col ;FIXME: we knew this when computing smie--parent. |
1302 | (save-excursion | |
1303 | (goto-char (cadr smie--parent)) | |
1304 | (smie-indent-forward-token) | |
1305 | (forward-comment (point-max)) | |
1306 | (current-column)))) | |
1307 | (cons 'column | |
1308 | (max parent-col | |
1309 | (min parent-pos-col | |
1310 | (- parent-pos-col (smie-indent--separator-outdent))))))) | |
1311 | ((and (eq method :after) (smie-indent--bolp)) | |
1312 | (smie-indent--separator-outdent)))) | |
1313 | ||
1314 | (defun smie-indent--offset (elem) | |
1315 | (or (funcall smie-rules-function :elem elem) | |
1316 | (if (not (eq elem 'basic)) | |
1317 | (funcall smie-rules-function :elem 'basic)) | |
1318 | smie-indent-basic)) | |
1319 | ||
1320 | (defun smie-indent--rule (method token | |
1321 | ;; FIXME: Too many parameters. | |
1322 | &optional after parent base-pos) | |
5556c0ce DG |
1323 | "Compute indentation column according to `smie-rules-function'. |
1324 | METHOD and TOKEN are passed to `smie-rules-function'. | |
7f925a67 SM |
1325 | AFTER is the position after TOKEN, if known. |
1326 | PARENT is the parent info returned by `smie-backward-sexp', if known. | |
1327 | BASE-POS is the position relative to which offsets should be applied." | |
1328 | ;; This is currently called in 3 cases: | |
1329 | ;; - :before opener, where rest=nil but base-pos could as well be parent. | |
1330 | ;; - :before other, where | |
1331 | ;; ; after=nil | |
1332 | ;; ; parent is set | |
1333 | ;; ; base-pos=parent | |
1334 | ;; - :after tok, where | |
1335 | ;; ; after is set; parent=nil; base-pos=point; | |
1336 | (save-excursion | |
5556c0ce | 1337 | (let ((offset (smie-indent--rule-1 method token after parent))) |
7f925a67 SM |
1338 | (cond |
1339 | ((not offset) nil) | |
1340 | ((eq (car-safe offset) 'column) (cdr offset)) | |
1341 | ((integerp offset) | |
1342 | (+ offset | |
1343 | (if (null base-pos) 0 | |
1344 | (goto-char base-pos) | |
7bea8c7a SM |
1345 | ;; Use smie-indent-virtual when indenting relative to an opener: |
1346 | ;; this will also by default use current-column unless | |
1347 | ;; that opener is hanging, but will additionally consult | |
1348 | ;; rules-function, so it gives it a chance to tweak indentation | |
1349 | ;; (e.g. by forcing indentation relative to its own parent, as in | |
1350 | ;; fn a => fn b => fn c =>). | |
1351 | ;; When parent==nil it doesn't matter because the only case | |
1352 | ;; where it's really used is when the base-pos is hanging anyway. | |
1353 | (if (or (and parent (null (car parent))) | |
1354 | (smie-indent--hanging-p)) | |
7f925a67 SM |
1355 | (smie-indent-virtual) (current-column))))) |
1356 | (t (error "Unknown indentation offset %s" offset)))))) | |
1357 | ||
5556c0ce DG |
1358 | (defun smie-indent--rule-1 (method token &optional after parent) |
1359 | (let ((smie--parent parent) | |
1360 | (smie--token token) | |
1361 | (smie--after after)) | |
1362 | (funcall smie-rules-function method token))) | |
1363 | ||
7f925a67 SM |
1364 | (defun smie-indent-forward-token () |
1365 | "Skip token forward and return it, along with its levels." | |
1366 | (let ((tok (funcall smie-forward-token-function))) | |
1367 | (cond | |
1368 | ((< 0 (length tok)) (assoc tok smie-grammar)) | |
1369 | ((looking-at "\\s(\\|\\s)\\(\\)") | |
1370 | (forward-char 1) | |
71e3276b | 1371 | (cons (buffer-substring-no-properties (1- (point)) (point)) |
bdda4c66 | 1372 | (if (match-end 1) '(0 nil) '(nil 0)))) |
71e3276b | 1373 | ((looking-at "\\s\"\\|\\s|") |
bdda4c66 SM |
1374 | (forward-sexp 1) |
1375 | nil) | |
1376 | ((eobp) nil) | |
1377 | (t (error "Bumped into unknown token"))))) | |
7f925a67 SM |
1378 | |
1379 | (defun smie-indent-backward-token () | |
1380 | "Skip token backward and return it, along with its levels." | |
1381 | (let ((tok (funcall smie-backward-token-function)) | |
1382 | class) | |
1383 | (cond | |
1384 | ((< 0 (length tok)) (assoc tok smie-grammar)) | |
1385 | ;; 4 == open paren syntax, 5 == close. | |
1386 | ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5)) | |
1387 | (forward-char -1) | |
71e3276b | 1388 | (cons (buffer-substring-no-properties (point) (1+ (point))) |
bdda4c66 | 1389 | (if (eq class 4) '(nil 0) '(0 nil)))) |
71e3276b | 1390 | ((memq class '(7 15)) |
bdda4c66 SM |
1391 | (backward-sexp 1) |
1392 | nil) | |
1393 | ((bobp) nil) | |
1394 | (t (error "Bumped into unknown token"))))) | |
7f925a67 SM |
1395 | |
1396 | (defun smie-indent-virtual () | |
1397 | ;; We used to take an optional arg (with value :not-hanging) to specify that | |
1398 | ;; we should only use (smie-indent-calculate) if we're looking at a hanging | |
1399 | ;; keyword. This was a bad idea, because the virtual indent of a position | |
1400 | ;; should not depend on the caller, since it leads to situations where two | |
1401 | ;; dependent indentations get indented differently. | |
1402 | "Compute the virtual indentation to use for point. | |
1403 | This is used when we're not trying to indent point but just | |
1404 | need to compute the column at which point should be indented | |
1405 | in order to figure out the indentation of some other (further down) point." | |
1406 | ;; Trust pre-existing indentation on other lines. | |
1407 | (if (smie-indent--bolp) (current-column) (smie-indent-calculate))) | |
1408 | ||
1409 | (defun smie-indent-fixindent () | |
1410 | ;; Obey the `fixindent' special comment. | |
1411 | (and (smie-indent--bolp) | |
1412 | (save-excursion | |
1413 | (comment-normalize-vars) | |
1414 | (re-search-forward (concat comment-start-skip | |
1415 | "fixindent" | |
1416 | comment-end-skip) | |
1417 | ;; 1+ to account for the \n comment termination. | |
1418 | (1+ (line-end-position)) t)) | |
1419 | (current-column))) | |
1420 | ||
1421 | (defun smie-indent-bob () | |
1422 | ;; Start the file at column 0. | |
1423 | (save-excursion | |
1424 | (forward-comment (- (point))) | |
1425 | (if (bobp) 0))) | |
1426 | ||
1427 | (defun smie-indent-close () | |
1428 | ;; Align close paren with opening paren. | |
1429 | (save-excursion | |
1430 | ;; (forward-comment (point-max)) | |
1431 | (when (looking-at "\\s)") | |
5556c0ce DG |
1432 | (if (smie-indent--rule-1 :close-all |
1433 | (buffer-substring-no-properties | |
1434 | (point) (1+ (point))) | |
1435 | (1+ (point))) | |
1436 | (while (not (zerop (skip-syntax-forward ")"))) | |
1437 | (skip-chars-forward " \t")) | |
1438 | (forward-char 1)) | |
7f925a67 SM |
1439 | (condition-case nil |
1440 | (progn | |
1441 | (backward-sexp 1) | |
1442 | (smie-indent-virtual)) ;:not-hanging | |
1443 | (scan-error nil))))) | |
1444 | ||
09ffa822 SM |
1445 | (defun smie-indent-keyword (&optional token) |
1446 | "Indent point based on the token that follows it immediately. | |
1447 | If TOKEN is non-nil, assume that that is the token that follows point. | |
1448 | Returns either a column number or nil if it considers that indentation | |
1449 | should not be computed on the basis of the following token." | |
7f925a67 SM |
1450 | (save-excursion |
1451 | (let* ((pos (point)) | |
09ffa822 SM |
1452 | (toklevels |
1453 | (if token | |
1454 | (assoc token smie-grammar) | |
1455 | (let* ((res (smie-indent-forward-token))) | |
1456 | ;; Ignore tokens on subsequent lines. | |
1457 | (if (and (< pos (line-beginning-position)) | |
1458 | ;; Make sure `token' also *starts* on another line. | |
1459 | (save-excursion | |
ced3fc5d SM |
1460 | (let ((endpos (point))) |
1461 | (goto-char pos) | |
1462 | (forward-line 1) | |
1463 | (and (equal res (smie-indent-forward-token)) | |
1464 | (eq (point) endpos))))) | |
09ffa822 SM |
1465 | nil |
1466 | (goto-char pos) | |
1467 | res))))) | |
1468 | (setq token (pop toklevels)) | |
e2f454c4 | 1469 | (cond |
09ffa822 | 1470 | ((null (cdr toklevels)) nil) ;Not a keyword. |
e2f454c4 | 1471 | ((not (numberp (car toklevels))) |
09ffa822 SM |
1472 | ;; Different cases: |
1473 | ;; - smie-indent--bolp: "indent according to others". | |
1474 | ;; - common hanging: "indent according to others". | |
1475 | ;; - SML-let hanging: "indent like parent". | |
1476 | ;; - if-after-else: "indent-like parent". | |
1477 | ;; - middle-of-line: "trust current position". | |
1478 | (cond | |
1479 | ((smie-indent--rule :before token)) | |
fdb058c2 | 1480 | ((smie-indent--bolp-1) ;I.e. non-virtual indent. |
09ffa822 SM |
1481 | ;; For an open-paren-like thingy at BOL, always indent only |
1482 | ;; based on other rules (typically smie-indent-after-keyword). | |
fdb058c2 SM |
1483 | ;; FIXME: we do the same if after a comment, since we may be trying |
1484 | ;; to compute the indentation of this comment and we shouldn't indent | |
1485 | ;; based on the indentation of subsequent code. | |
09ffa822 SM |
1486 | nil) |
1487 | (t | |
1488 | ;; By default use point unless we're hanging. | |
1489 | (unless (smie-indent--hanging-p) (current-column))))) | |
e2f454c4 | 1490 | (t |
7f925a67 | 1491 | ;; FIXME: This still looks too much like black magic!! |
09ffa822 | 1492 | (let* ((parent (smie-backward-sexp token))) |
7f925a67 SM |
1493 | ;; Different behaviors: |
1494 | ;; - align with parent. | |
1495 | ;; - parent + offset. | |
1496 | ;; - after parent's column + offset (actually, after or before | |
1497 | ;; depending on where backward-sexp stopped). | |
1498 | ;; ? let it drop to some other indentation function (almost never). | |
1499 | ;; ? parent + offset + parent's own offset. | |
1500 | ;; Different cases: | |
1501 | ;; - bump into a same-level operator. | |
1502 | ;; - bump into a specific known parent. | |
1503 | ;; - find a matching open-paren thingy. | |
1504 | ;; - bump into some random parent. | |
1505 | ;; ? borderline case (almost never). | |
1506 | ;; ? bump immediately into a parent. | |
1507 | (cond | |
1508 | ((not (or (< (point) pos) | |
1509 | (and (cadr parent) (< (cadr parent) pos)))) | |
1510 | ;; If we didn't move at all, that means we didn't really skip | |
1511 | ;; what we wanted. Should almost never happen, other than | |
1512 | ;; maybe when an infix or close-paren is at the beginning | |
1513 | ;; of a buffer. | |
1514 | nil) | |
1515 | ((save-excursion | |
1516 | (goto-char pos) | |
1517 | (smie-indent--rule :before token nil parent (cadr parent)))) | |
1518 | ((eq (car parent) (car toklevels)) | |
1519 | ;; We bumped into a same-level operator; align with it. | |
1520 | (if (and (smie-indent--bolp) (/= (point) pos) | |
1521 | (save-excursion | |
1522 | (goto-char (goto-char (cadr parent))) | |
1523 | (not (smie-indent--bolp)))) | |
1524 | ;; If the parent is at EOL and its children are indented like | |
1525 | ;; itself, then we can just obey the indentation chosen for the | |
1526 | ;; child. | |
1527 | ;; This is important for operators like ";" which | |
1528 | ;; are usually at EOL (and have an offset of 0): otherwise we'd | |
1529 | ;; always go back over all the statements, which is | |
1530 | ;; a performance problem and would also mean that fixindents | |
1531 | ;; in the middle of such a sequence would be ignored. | |
1532 | ;; | |
1533 | ;; This is a delicate point! | |
1534 | ;; Even if the offset is not 0, we could follow the same logic | |
1535 | ;; and subtract the offset from the child's indentation. | |
1536 | ;; But that would more often be a bad idea: OT1H we generally | |
1537 | ;; want to reuse the closest similar indentation point, so that | |
1538 | ;; the user's choice (or the fixindents) are obeyed. But OTOH | |
1539 | ;; we don't want this to affect "unrelated" parts of the code. | |
1540 | ;; E.g. a fixindent in the body of a "begin..end" should not | |
1541 | ;; affect the indentation of the "end". | |
1542 | (current-column) | |
1543 | (goto-char (cadr parent)) | |
1544 | ;; Don't use (smie-indent-virtual :not-hanging) here, because we | |
1545 | ;; want to jump back over a sequence of same-level ops such as | |
1546 | ;; a -> b -> c | |
1547 | ;; -> d | |
1548 | ;; So as to align with the earliest appropriate place. | |
1549 | (smie-indent-virtual))) | |
1550 | (t | |
1551 | (if (and (= (point) pos) (smie-indent--bolp)) | |
1552 | ;; Since we started at BOL, we're not computing a virtual | |
1553 | ;; indentation, and we're still at the starting point, so | |
1554 | ;; we can't use `current-column' which would cause | |
1555 | ;; indentation to depend on itself and we can't use | |
1556 | ;; smie-indent-virtual since that would be an inf-loop. | |
1557 | nil | |
1558 | ;; In indent-keyword, if we're indenting `then' wrt `if', we | |
1559 | ;; want to use indent-virtual rather than use just | |
1560 | ;; current-column, so that we can apply the (:before . "if") | |
1561 | ;; rule which does the "else if" dance in SML. But in other | |
1562 | ;; cases, we do not want to use indent-virtual (e.g. indentation | |
1563 | ;; of "*" w.r.t "+", or ";" wrt "("). We could just always use | |
1564 | ;; indent-virtual and then have indent-rules say explicitly to | |
1565 | ;; use `point' after things like "(" or "+" when they're not at | |
1566 | ;; EOL, but you'd end up with lots of those rules. | |
1567 | ;; So we use a heuristic here, which is that we only use virtual | |
1568 | ;; if the parent is tightly linked to the child token (they're | |
1569 | ;; part of the same BNF rule). | |
e2f454c4 | 1570 | (if (car parent) (current-column) (smie-indent-virtual))))))))))) |
7f925a67 SM |
1571 | |
1572 | (defun smie-indent-comment () | |
1573 | "Compute indentation of a comment." | |
1574 | ;; Don't do it for virtual indentations. We should normally never be "in | |
1575 | ;; front of a comment" when doing virtual-indentation anyway. And if we are | |
1576 | ;; (as can happen in octave-mode), moving forward can lead to inf-loops. | |
1577 | (and (smie-indent--bolp) | |
1578 | (let ((pos (point))) | |
1579 | (save-excursion | |
1580 | (beginning-of-line) | |
1581 | (and (re-search-forward comment-start-skip (line-end-position) t) | |
1582 | (eq pos (or (match-end 1) (match-beginning 0)))))) | |
1583 | (save-excursion | |
1584 | (forward-comment (point-max)) | |
1585 | (skip-chars-forward " \t\r\n") | |
ced3fc5d SM |
1586 | (unless |
1587 | ;; Don't align with a closer, since the comment is "within" the | |
1588 | ;; closed element. Don't align with EOB either. | |
1589 | (save-excursion | |
1590 | (let ((next (funcall smie-forward-token-function))) | |
1591 | (or (if (zerop (length next)) | |
1592 | (or (eobp) (eq (car (syntax-after (point))) 5))) | |
1593 | (rassoc next smie-closer-alist)))) | |
1594 | ;; FIXME: We assume here that smie-indent-calculate will compute the | |
1595 | ;; indentation of the next token based on text before the comment, | |
1596 | ;; but this is not guaranteed, so maybe we should let | |
1597 | ;; smie-indent-calculate return some info about which buffer | |
1598 | ;; position was used as the "indentation base" and check that this | |
1599 | ;; base is before `pos'. | |
1600 | (smie-indent-calculate))))) | |
7f925a67 SM |
1601 | |
1602 | (defun smie-indent-comment-continue () | |
1603 | ;; indentation of comment-continue lines. | |
1604 | (let ((continue (and comment-continue | |
1605 | (comment-string-strip comment-continue t t)))) | |
1606 | (and (< 0 (length continue)) | |
1607 | (looking-at (regexp-quote continue)) (nth 4 (syntax-ppss)) | |
1608 | (let ((ppss (syntax-ppss))) | |
1609 | (save-excursion | |
1610 | (forward-line -1) | |
1611 | (if (<= (point) (nth 8 ppss)) | |
1612 | (progn (goto-char (1+ (nth 8 ppss))) (current-column)) | |
1613 | (skip-chars-forward " \t") | |
1614 | (if (looking-at (regexp-quote continue)) | |
1615 | (current-column)))))))) | |
1616 | ||
1617 | (defun smie-indent-comment-close () | |
1618 | (and (boundp 'comment-end-skip) | |
1619 | comment-end-skip | |
1620 | (not (looking-at " \t*$")) ;Not just a \n comment-closer. | |
1621 | (looking-at comment-end-skip) | |
7bea8c7a SM |
1622 | (let ((end (match-string 0))) |
1623 | (and (nth 4 (syntax-ppss)) | |
1624 | (save-excursion | |
1625 | (goto-char (nth 8 (syntax-ppss))) | |
1626 | (and (looking-at comment-start-skip) | |
1627 | (let ((start (match-string 0))) | |
1628 | ;; Align the common substring between starter | |
1629 | ;; and ender, if possible. | |
1630 | (if (string-match "\\(.+\\).*\n\\(.*?\\)\\1" | |
1631 | (concat start "\n" end)) | |
1632 | (+ (current-column) (match-beginning 0) | |
1633 | (- (match-beginning 2) (match-end 2))) | |
1634 | (current-column))))))))) | |
7f925a67 SM |
1635 | |
1636 | (defun smie-indent-comment-inside () | |
1637 | (and (nth 4 (syntax-ppss)) | |
1638 | 'noindent)) | |
1639 | ||
9517f8af SM |
1640 | (defun smie-indent-inside-string () |
1641 | (and (nth 3 (syntax-ppss)) | |
1642 | 'noindent)) | |
1643 | ||
7f925a67 SM |
1644 | (defun smie-indent-after-keyword () |
1645 | ;; Indentation right after a special keyword. | |
1646 | (save-excursion | |
1647 | (let* ((pos (point)) | |
1648 | (toklevel (smie-indent-backward-token)) | |
1649 | (tok (car toklevel))) | |
1650 | (cond | |
1651 | ((null toklevel) nil) | |
1652 | ((smie-indent--rule :after tok pos nil (point))) | |
1653 | ;; The default indentation after a keyword/operator is | |
1654 | ;; 0 for infix, t for prefix, and use another rule | |
1655 | ;; for postfix. | |
e2f454c4 SM |
1656 | ((not (numberp (nth 2 toklevel))) nil) ;A closer. |
1657 | ((or (not (numberp (nth 1 toklevel))) ;An opener. | |
1658 | (rassoc tok smie-closer-alist)) ;An inner. | |
7f925a67 | 1659 | (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ; |
e2f454c4 | 1660 | (t (smie-indent-virtual)))))) ;An infix. |
7f925a67 SM |
1661 | |
1662 | (defun smie-indent-exps () | |
1663 | ;; Indentation of sequences of simple expressions without | |
1664 | ;; intervening keywords or operators. E.g. "a b c" or "g (balbla) f". | |
1665 | ;; Can be a list of expressions or a function call. | |
1666 | ;; If it's a function call, the first element is special (it's the | |
1667 | ;; function). We distinguish function calls from mere lists of | |
1668 | ;; expressions based on whether the preceding token is listed in | |
1669 | ;; the `list-intro' entry of smie-indent-rules. | |
1670 | ;; | |
1671 | ;; TODO: to indent Lisp code, we should add a way to specify | |
1672 | ;; particular indentation for particular args depending on the | |
1673 | ;; function (which would require always skipping back until the | |
1674 | ;; function). | |
1675 | ;; TODO: to indent C code, such as "if (...) {...}" we might need | |
1676 | ;; to add similar indentation hooks for particular positions, but | |
1677 | ;; based on the preceding token rather than based on the first exp. | |
1678 | (save-excursion | |
1679 | (let ((positions nil) | |
1680 | arg) | |
1681 | (while (and (null (car (smie-backward-sexp))) | |
1682 | (push (point) positions) | |
1683 | (not (smie-indent--bolp)))) | |
1684 | (save-excursion | |
1685 | ;; Figure out if the atom we just skipped is an argument rather | |
1686 | ;; than a function. | |
1687 | (setq arg | |
1688 | (or (null (car (smie-backward-sexp))) | |
1689 | (funcall smie-rules-function :list-intro | |
1690 | (funcall smie-backward-token-function))))) | |
1691 | (cond | |
1692 | ((null positions) | |
1693 | ;; We're the first expression of the list. In that case, the | |
1694 | ;; indentation should be (have been) determined by its context. | |
1695 | nil) | |
1696 | (arg | |
1697 | ;; There's a previous element, and it's not special (it's not | |
1698 | ;; the function), so let's just align with that one. | |
1699 | (goto-char (car positions)) | |
1700 | (current-column)) | |
1701 | ((cdr positions) | |
1702 | ;; We skipped some args plus the function and bumped into something. | |
1703 | ;; Align with the first arg. | |
1704 | (goto-char (cadr positions)) | |
1705 | (current-column)) | |
1706 | (positions | |
1707 | ;; We're the first arg. | |
1708 | (goto-char (car positions)) | |
1709 | (+ (smie-indent--offset 'args) | |
1710 | ;; We used to use (smie-indent-virtual), but that | |
1711 | ;; doesn't seem right since it might then indent args less than | |
1712 | ;; the function itself. | |
1713 | (current-column))))))) | |
1714 | ||
1715 | (defvar smie-indent-functions | |
1716 | '(smie-indent-fixindent smie-indent-bob smie-indent-close | |
9517f8af SM |
1717 | smie-indent-comment smie-indent-comment-continue smie-indent-comment-close |
1718 | smie-indent-comment-inside smie-indent-inside-string | |
1719 | smie-indent-keyword smie-indent-after-keyword | |
7f925a67 SM |
1720 | smie-indent-exps) |
1721 | "Functions to compute the indentation. | |
1722 | Each function is called with no argument, shouldn't move point, and should | |
1723 | return either nil if it has no opinion, or an integer representing the column | |
1724 | to which that point should be aligned, if we were to reindent it.") | |
1725 | ||
1726 | (defun smie-indent-calculate () | |
1727 | "Compute the indentation to use for point." | |
1728 | (run-hook-with-args-until-success 'smie-indent-functions)) | |
1729 | ||
1730 | (defun smie-indent-line () | |
1731 | "Indent current line using the SMIE indentation engine." | |
1732 | (interactive) | |
1733 | (let* ((savep (point)) | |
1734 | (indent (or (with-demoted-errors | |
1735 | (save-excursion | |
1736 | (forward-line 0) | |
1737 | (skip-chars-forward " \t") | |
1738 | (if (>= (point) savep) (setq savep nil)) | |
1739 | (or (smie-indent-calculate) 0))) | |
1740 | 0))) | |
1741 | (if (not (numberp indent)) | |
1742 | ;; If something funny is used (e.g. `noindent'), return it. | |
1743 | indent | |
1744 | (if (< indent 0) (setq indent 0)) ;Just in case. | |
1745 | (if savep | |
1746 | (save-excursion (indent-line-to indent)) | |
1747 | (indent-line-to indent))))) | |
1748 | ||
650cff3d | 1749 | (defun smie-auto-fill (do-auto-fill) |
4d6769e1 | 1750 | (let ((fc (current-fill-column))) |
650cff3d SM |
1751 | (when (and fc (> (current-column) fc)) |
1752 | ;; The loop below presumes BOL is outside of strings or comments. Also, | |
1753 | ;; sometimes we prefer to fill the comment than the code around it. | |
1754 | (unless (or (nth 8 (save-excursion | |
1755 | (syntax-ppss (line-beginning-position)))) | |
1756 | (nth 4 (save-excursion | |
1757 | (move-to-column fc) | |
1758 | (syntax-ppss)))) | |
1759 | (while | |
1760 | (and (with-demoted-errors | |
1761 | (save-excursion | |
1762 | (let ((end (point)) | |
1763 | (bsf nil) ;Best-so-far. | |
1764 | (gain 0)) | |
1765 | (beginning-of-line) | |
1766 | (while (progn | |
efe8bf5d | 1767 | (smie-indent-forward-token) |
650cff3d SM |
1768 | (and (<= (point) end) |
1769 | (<= (current-column) fc))) | |
1770 | ;; FIXME? `smie-indent-calculate' can (and often | |
1771 | ;; does) return a result that actually depends on the | |
1772 | ;; presence/absence of a newline, so the gain computed | |
1773 | ;; here may not be accurate, but in practice it seems | |
1774 | ;; to work well enough. | |
1775 | (skip-chars-forward " \t") | |
1776 | (let* ((newcol (smie-indent-calculate)) | |
1777 | (newgain (- (current-column) newcol))) | |
1778 | (when (> newgain gain) | |
1779 | (setq gain newgain) | |
1780 | (setq bsf (point))))) | |
1781 | (when (> gain 0) | |
1782 | (goto-char bsf) | |
1783 | (newline-and-indent) | |
1784 | 'done)))) | |
1785 | (> (current-column) fc)))) | |
1786 | (when (> (current-column) fc) | |
1787 | (funcall do-auto-fill))))) | |
3f99e6e6 SM |
1788 | |
1789 | ||
7f925a67 SM |
1790 | (defun smie-setup (grammar rules-function &rest keywords) |
1791 | "Setup SMIE navigation and indentation. | |
1792 | GRAMMAR is a grammar table generated by `smie-prec2->grammar'. | |
1793 | RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. | |
1794 | KEYWORDS are additional arguments, which can use the following keywords: | |
1795 | - :forward-token FUN | |
1796 | - :backward-token FUN" | |
650cff3d SM |
1797 | (setq-local smie-rules-function rules-function) |
1798 | (setq-local smie-grammar grammar) | |
1799 | (setq-local indent-line-function #'smie-indent-line) | |
1800 | (add-function :around (local 'normal-auto-fill-function) #'smie-auto-fill) | |
1801 | (setq-local forward-sexp-function #'smie-forward-sexp-command) | |
7f925a67 SM |
1802 | (while keywords |
1803 | (let ((k (pop keywords)) | |
1804 | (v (pop keywords))) | |
f80efb86 SM |
1805 | (pcase k |
1806 | (`:forward-token | |
7f925a67 | 1807 | (set (make-local-variable 'smie-forward-token-function) v)) |
f80efb86 | 1808 | (`:backward-token |
7f925a67 | 1809 | (set (make-local-variable 'smie-backward-token-function) v)) |
f80efb86 | 1810 | (_ (message "smie-setup: ignoring unknown keyword %s" k))))) |
7f925a67 SM |
1811 | (let ((ca (cdr (assq :smie-closer-alist grammar)))) |
1812 | (when ca | |
650cff3d | 1813 | (setq-local smie-closer-alist ca) |
7f925a67 | 1814 | ;; Only needed for interactive calls to blink-matching-open. |
650cff3d | 1815 | (setq-local blink-matching-check-function #'smie-blink-matching-check) |
976cb066 LL |
1816 | (add-hook 'post-self-insert-hook |
1817 | #'smie-blink-matching-open 'append 'local) | |
1818 | (add-function :around (local 'show-paren-data-function) | |
1819 | #'smie--matching-block-data) | |
650cff3d SM |
1820 | ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to |
1821 | ;; blink, try to blink as soon as we type the last char of a block ender. | |
1822 | (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp)) | |
1823 | (triggers ()) | |
1824 | closer) | |
1825 | (while (setq closer (pop closers)) | |
1826 | (unless | |
1827 | ;; FIXME: this eliminates prefixes of other closers, but we | |
1828 | ;; should probably eliminate prefixes of other keywords as well. | |
1829 | (and closers (string-prefix-p closer (car closers))) | |
1830 | (push (aref closer (1- (length closer))) triggers))) | |
1831 | (setq-local smie-blink-matching-triggers | |
1832 | (append smie-blink-matching-triggers | |
1833 | (delete-dups triggers))))))) | |
7f925a67 | 1834 | |
71e3276b SM |
1835 | (defun smie-edebug () |
1836 | "Instrument the `smie-rules-function' for Edebug." | |
1837 | (interactive) | |
1838 | (require 'edebug) | |
1839 | (if (symbolp smie-rules-function) | |
1840 | (edebug-instrument-function smie-rules-function) | |
1841 | (error "Sorry, don't know how to instrument a lambda expression"))) | |
1842 | ||
e61845c1 SM |
1843 | (defun smie--next-indent-change () |
1844 | "Go to the next line that needs to be reindented (and reindent it)." | |
1845 | (interactive) | |
1846 | (while | |
a0d5f7a4 | 1847 | (let ((tick (buffer-chars-modified-tick))) |
e61845c1 | 1848 | (indent-according-to-mode) |
a0d5f7a4 | 1849 | (eq tick (buffer-chars-modified-tick))) |
e61845c1 SM |
1850 | (forward-line 1))) |
1851 | ||
71e3276b SM |
1852 | ;;; User configuration |
1853 | ||
1854 | ;; This is designed to be a completely independent "module", so we can play | |
1855 | ;; with various kinds of smie-config modules without having to change the core. | |
1856 | ||
1857 | ;; This smie-config module is fairly primitive and suffers from serious | |
1858 | ;; restrictions: | |
1859 | ;; - You can only change a returned offset, so you can't change the offset | |
1860 | ;; passed to smie-rule-parent, nor can you change the object with which | |
1861 | ;; to align (in general). | |
1862 | ;; - The rewrite rule can only distinguish cases based on the kind+token arg | |
1863 | ;; and smie-rules-function's return value, so you can't distinguish cases | |
1864 | ;; where smie-rules-function returns the same value. | |
1865 | ;; - Since config-rules depend on the return value of smie-rules-function, any | |
1866 | ;; config change that modifies this return value (e.g. changing | |
1867 | ;; foo-indent-basic) ends up invalidating config-rules. | |
1868 | ;; This last one is a serious problem since it means that file-local | |
1869 | ;; config-rules will only work if the user hasn't changed foo-indent-basic. | |
1870 | ;; One possible way to change it is to modify smie-rules-functions so they can | |
1871 | ;; return special symbols like +, ++, -, etc. Or make them use a new | |
1872 | ;; smie-rule-basic function which can then be used to know when a returned | |
1873 | ;; offset was computed based on foo-indent-basic. | |
1874 | ||
1875 | (defvar-local smie-config--mode-local nil | |
1876 | "Indentation config rules installed for this major mode. | |
1877 | Typically manipulated from the major-mode's hook.") | |
1878 | (defvar-local smie-config--buffer-local nil | |
1879 | "Indentation config rules installed for this very buffer. | |
1880 | E.g. provided via a file-local call to `smie-config-local'.") | |
1881 | (defvar smie-config--trace nil | |
1882 | "Variable used to trace calls to `smie-rules-function'.") | |
1883 | ||
1884 | (defun smie-config--advice (orig kind token) | |
1885 | (let* ((ret (funcall orig kind token)) | |
1886 | (sig (list kind token ret)) | |
1887 | (brule (rassoc sig smie-config--buffer-local)) | |
1888 | (mrule (rassoc sig smie-config--mode-local))) | |
1889 | (when smie-config--trace | |
1890 | (setq smie-config--trace (or brule mrule))) | |
1891 | (cond | |
1892 | (brule (car brule)) | |
1893 | (mrule (car mrule)) | |
1894 | (t ret)))) | |
1895 | ||
1896 | (defun smie-config--mode-hook (rules) | |
1897 | (setq smie-config--mode-local | |
1898 | (append rules smie-config--mode-local)) | |
1899 | (add-function :around (local 'smie-rules-function) #'smie-config--advice)) | |
1900 | ||
1901 | (defvar smie-config--modefuns nil) | |
1902 | ||
1903 | (defun smie-config--setter (var value) | |
1904 | (setq-default var value) | |
1905 | (let ((old-modefuns smie-config--modefuns)) | |
1906 | (setq smie-config--modefuns nil) | |
1907 | (pcase-dolist (`(,mode . ,rules) value) | |
1908 | (let ((modefunname (intern (format "smie-config--modefun-%s" mode)))) | |
1909 | (fset modefunname (lambda () (smie-config--mode-hook rules))) | |
1910 | (push modefunname smie-config--modefuns) | |
1911 | (add-hook (intern (format "%s-hook" mode)) modefunname))) | |
1912 | ;; Neuter any left-over previously installed hook. | |
1913 | (dolist (modefun old-modefuns) | |
1914 | (unless (memq modefun smie-config--modefuns) | |
1915 | (fset modefun #'ignore))))) | |
1916 | ||
1917 | (defcustom smie-config nil | |
1918 | ;; FIXME: there should be a file-local equivalent. | |
1919 | "User configuration of SMIE indentation. | |
1920 | This is a list of elements (MODE . RULES), where RULES is a list | |
1921 | of elements describing when and how to change the indentation rules. | |
1922 | Each RULE element should be of the form (NEW KIND TOKEN NORMAL), | |
1923 | where KIND and TOKEN are the elements passed to `smie-rules-function', | |
1924 | NORMAL is the value returned by `smie-rules-function' and NEW is the | |
1925 | value with which to replace it." | |
bb098075 GM |
1926 | :version "24.4" |
1927 | ;; FIXME improve value-type. | |
1928 | :type '(choice (const nil) | |
1929 | (alist :key-type symbol)) | |
1930 | :initialize 'custom-initialize-default | |
71e3276b SM |
1931 | :set #'smie-config--setter) |
1932 | ||
1933 | (defun smie-config-local (rules) | |
1934 | "Add RULES as local indentation rules to use in this buffer. | |
1935 | These replace any previous local rules, but supplement the rules | |
1936 | specified in `smie-config'." | |
1937 | (setq smie-config--buffer-local rules) | |
1938 | (add-function :around (local 'smie-rules-function) #'smie-config--advice)) | |
1939 | ||
1940 | ;; Make it so we can set those in the file-local block. | |
1941 | ;; FIXME: Better would be to be able to write "smie-config-local: (...)" rather | |
1942 | ;; than "eval: (smie-config-local '(...))". | |
1943 | (put 'smie-config-local 'safe-local-eval-function t) | |
1944 | ||
1945 | (defun smie-config--get-trace () | |
1946 | (save-excursion | |
1947 | (forward-line 0) | |
1948 | (skip-chars-forward " \t") | |
1949 | (let* ((trace ()) | |
1950 | (srf-fun (lambda (orig kind token) | |
1951 | (let* ((pos (point)) | |
1952 | (smie-config--trace t) | |
1953 | (res (funcall orig kind token))) | |
1954 | (push (if (consp smie-config--trace) | |
1955 | (list pos kind token res smie-config--trace) | |
1956 | (list pos kind token res)) | |
1957 | trace) | |
1958 | res)))) | |
1959 | (unwind-protect | |
1960 | (progn | |
1961 | (add-function :around (local 'smie-rules-function) srf-fun) | |
1962 | (cons (smie-indent-calculate) | |
1963 | trace)) | |
1964 | (remove-function (local 'smie-rules-function) srf-fun))))) | |
1965 | ||
1966 | (defun smie-config-show-indent (&optional arg) | |
1967 | "Display the SMIE rules that are used to indent the current line. | |
1968 | If prefix ARG is given, then move briefly point to the buffer | |
1969 | position corresponding to each rule." | |
1970 | (interactive "P") | |
1971 | (let ((trace (cdr (smie-config--get-trace)))) | |
1972 | (cond | |
1973 | ((null trace) (message "No SMIE rules involved")) | |
1974 | ((not arg) | |
1975 | (message "Rules used: %s" | |
1976 | (mapconcat (lambda (elem) | |
1977 | (pcase-let ((`(,_pos ,kind ,token ,res ,rewrite) | |
1978 | elem)) | |
1979 | (format "%S %S -> %S%s" kind token res | |
1980 | (if (null rewrite) "" | |
1981 | (format "(via %S)" (nth 3 rewrite)))))) | |
1982 | trace | |
1983 | ", "))) | |
1984 | (t | |
1985 | (save-excursion | |
1986 | (pcase-dolist (`(,pos ,kind ,token ,res ,rewrite) trace) | |
1987 | (message "%S %S -> %S%s" kind token res | |
1988 | (if (null rewrite) "" | |
1989 | (format "(via %S)" (nth 3 rewrite)))) | |
1990 | (goto-char pos) | |
1991 | (sit-for blink-matching-delay))))))) | |
1992 | ||
1993 | (defun smie-config--guess-value (sig) | |
1994 | (add-function :around (local 'smie-rules-function) #'smie-config--advice) | |
1995 | (let* ((rule (cons 0 sig)) | |
1996 | (smie-config--buffer-local (cons rule smie-config--buffer-local)) | |
1997 | (goal (current-indentation)) | |
1998 | (cur (smie-indent-calculate))) | |
1999 | (cond | |
2000 | ((and (eq goal | |
2001 | (progn (setf (car rule) (- goal cur)) | |
2002 | (smie-indent-calculate)))) | |
2003 | (- goal cur))))) | |
2004 | ||
2005 | (defun smie-config-set-indent () | |
2006 | "Add a rule to adjust the indentation of current line." | |
2007 | (interactive) | |
2008 | (let* ((trace (cdr (smie-config--get-trace))) | |
2009 | (_ (unless trace (error "No SMIE rules involved"))) | |
2010 | (sig (if (null (cdr trace)) | |
2011 | (pcase-let* ((elem (car trace)) | |
2012 | (`(,_pos ,kind ,token ,res ,rewrite) elem)) | |
2013 | (list kind token (or (nth 3 rewrite) res))) | |
2014 | (let* ((choicestr | |
2015 | (completing-read | |
2016 | "Adjust rule: " | |
2017 | (mapcar (lambda (elem) | |
2018 | (format "%s %S" | |
2019 | (substring (symbol-name (cadr elem)) | |
2020 | 1) | |
2021 | (nth 2 elem))) | |
2022 | trace) | |
2023 | nil t nil nil | |
2024 | nil)) ;FIXME: Provide good default! | |
2025 | (choicelst (car (read-from-string | |
2026 | (concat "(:" choicestr ")"))))) | |
2027 | (catch 'found | |
2028 | (pcase-dolist (`(,_pos ,kind ,token ,res ,rewrite) trace) | |
2029 | (when (and (eq kind (car choicelst)) | |
2030 | (equal token (nth 1 choicelst))) | |
2031 | (throw 'found (list kind token | |
2032 | (or (nth 3 rewrite) res))))))))) | |
2033 | (default-new (smie-config--guess-value sig)) | |
2034 | (newstr (read-string (format "Adjust rule (%S %S -> %S) to%s: " | |
2035 | (nth 0 sig) (nth 1 sig) (nth 2 sig) | |
2036 | (if (not default-new) "" | |
2037 | (format " (default %S)" default-new))) | |
2038 | nil nil (format "%S" default-new))) | |
2039 | (new (car (read-from-string newstr)))) | |
2040 | (let ((old (rassoc sig smie-config--buffer-local))) | |
2041 | (when old | |
2042 | (setq smie-config--buffer-local | |
2043 | (remove old smie-config--buffer-local)))) | |
2044 | (push (cons new sig) smie-config--buffer-local) | |
2045 | (message "Added rule %S %S -> %S (via %S)" | |
2046 | (nth 0 sig) (nth 1 sig) new (nth 2 sig)) | |
2047 | (add-function :around (local 'smie-rules-function) #'smie-config--advice))) | |
2048 | ||
2049 | (defun smie-config--guess (beg end) | |
2050 | (let ((otraces (make-hash-table :test #'equal)) | |
2051 | (smie-config--buffer-local nil) | |
2052 | (smie-config--mode-local nil) | |
2053 | (pr (make-progress-reporter "Analyzing the buffer" beg end))) | |
2054 | ||
2055 | ;; First, lets get the indentation traces and offsets for the region. | |
2056 | (save-excursion | |
2057 | (goto-char beg) | |
2058 | (forward-line 0) | |
2059 | (while (< (point) end) | |
2060 | (skip-chars-forward " \t") | |
2061 | (unless (eolp) ;Skip empty lines. | |
2062 | (progress-reporter-update pr (point)) | |
2063 | (let* ((itrace (smie-config--get-trace)) | |
2064 | (nindent (car itrace)) | |
2065 | (trace (mapcar #'cdr (cdr itrace))) | |
2066 | (cur (current-indentation))) | |
2067 | (when (numberp nindent) ;Skip `noindent' and friends. | |
2068 | (cl-incf (gethash (cons (- cur nindent) trace) otraces 0))))) | |
2069 | (forward-line 1))) | |
2070 | (progress-reporter-done pr) | |
2071 | ||
2072 | ;; Second, compile the data. Our algorithm only knows how to adjust rules | |
2073 | ;; where the smie-rules-function returns an integer. We call those | |
2074 | ;; "adjustable sigs". We build a table mapping each adjustable sig | |
2075 | ;; to its data, describing the total number of times we encountered it, | |
2076 | ;; the offsets found, and the traces in which it was found. | |
2077 | (message "Guessing...") | |
2078 | (let ((sigs (make-hash-table :test #'equal))) | |
2079 | (maphash (lambda (otrace count) | |
2080 | (let ((offset (car otrace)) | |
2081 | (trace (cdr otrace)) | |
2082 | (double nil)) | |
2083 | (let ((sigs trace)) | |
2084 | (while sigs | |
2085 | (let ((sig (pop sigs))) | |
2086 | (if (and (integerp (nth 2 sig)) (member sig sigs)) | |
2087 | (setq double t))))) | |
2088 | (if double | |
2089 | ;; Disregard those traces where an adjustable sig | |
2090 | ;; appears twice, because the rest of the code assumes | |
2091 | ;; that adding a rule to add an offset N will change the | |
2092 | ;; end result by N rather than 2*N or more. | |
2093 | nil | |
2094 | (dolist (sig trace) | |
2095 | (if (not (integerp (nth 2 sig))) | |
2096 | ;; Disregard those sigs that return nil or a column, | |
2097 | ;; because our algorithm doesn't know how to adjust | |
2098 | ;; them anyway. | |
2099 | nil | |
2100 | (let ((sig-data (or (gethash sig sigs) | |
2101 | (let ((data (list 0 nil nil))) | |
2102 | (puthash sig data sigs) | |
2103 | data)))) | |
2104 | (cl-incf (nth 0 sig-data) count) | |
2105 | (push (cons count otrace) (nth 2 sig-data)) | |
2106 | (let ((sig-off-data | |
2107 | (or (assq offset (nth 1 sig-data)) | |
2108 | (let ((off-data (cons offset 0))) | |
2109 | (push off-data (nth 1 sig-data)) | |
2110 | off-data)))) | |
2111 | (cl-incf (cdr sig-off-data) count)))))))) | |
2112 | otraces) | |
2113 | ||
2114 | ;; Finally, guess the indentation rules. | |
2115 | (let ((ssigs nil) | |
2116 | (rules nil)) | |
2117 | ;; Sort the sigs by frequency of occurrence. | |
2118 | (maphash (lambda (sig sig-data) (push (cons sig sig-data) ssigs)) sigs) | |
2119 | (setq ssigs (sort ssigs (lambda (sd1 sd2) (> (cadr sd1) (cadr sd2))))) | |
2120 | (while ssigs | |
2121 | (pcase-let ((`(,sig ,total ,off-alist ,cotraces) (pop ssigs))) | |
2122 | (cl-assert (= total (apply #'+ (mapcar #'cdr off-alist)))) | |
2123 | (let* ((sorted-off-alist | |
2124 | (sort off-alist (lambda (x y) (> (cdr x) (cdr y))))) | |
2125 | (offset (caar sorted-off-alist))) | |
2126 | (if (zerop offset) | |
2127 | ;; Nothing to do with this sig; indentation is | |
2128 | ;; correct already. | |
2129 | nil | |
2130 | (push (cons (+ offset (nth 2 sig)) sig) rules) | |
2131 | ;; Adjust the rest of the data. | |
2132 | (pcase-dolist ((and cotrace `(,count ,toffset ,trace)) | |
2133 | cotraces) | |
2134 | (setf (nth 1 cotrace) (- toffset offset)) | |
2135 | (dolist (sig trace) | |
2136 | (let ((sig-data (cdr (assq sig ssigs)))) | |
2137 | (when sig-data | |
2138 | (let* ((ooff-data (assq toffset (nth 1 sig-data))) | |
2139 | (noffset (- toffset offset)) | |
2140 | (noff-data | |
2141 | (or (assq noffset (nth 1 sig-data)) | |
2142 | (let ((off-data (cons noffset 0))) | |
2143 | (push off-data (nth 1 sig-data)) | |
2144 | off-data)))) | |
2145 | (cl-assert (>= (cdr ooff-data) count)) | |
2146 | (cl-decf (cdr ooff-data) count) | |
2147 | (cl-incf (cdr noff-data) count)))))))))) | |
2148 | (message "Guessing...done") | |
2149 | rules)))) | |
2150 | ||
2151 | (defun smie-config-guess () | |
2152 | "Try and figure out this buffer's indentation settings." | |
2153 | (interactive) | |
2154 | (let ((config (smie-config--guess (point-min) (point-max)))) | |
2155 | (cond | |
2156 | ((null config) (message "Nothing to change")) | |
2157 | ((null smie-config--buffer-local) | |
2158 | (message "Local rules set") | |
2159 | (setq smie-config--buffer-local config)) | |
2160 | ((y-or-n-p "Replace existing local config? ") | |
2161 | (message "Local rules replaced") | |
2162 | (setq smie-config--buffer-local config)) | |
2163 | ((y-or-n-p "Merge with existing local config? ") | |
2164 | (message "Local rules adjusted") | |
2165 | (setq smie-config--buffer-local | |
2166 | (append config smie-config--buffer-local))) | |
2167 | (t | |
2168 | (message "Rules guessed: %S" config))))) | |
2169 | ||
2170 | (defun smie-config-save () | |
2171 | "Save local rules for use with this major mode." | |
2172 | (interactive) | |
2173 | (cond | |
2174 | ((null smie-config--buffer-local) | |
2175 | (message "No local rules to save")) | |
2176 | (t | |
2177 | (let* ((existing (assq major-mode smie-config)) | |
2178 | (config | |
2179 | (cond ((null existing) | |
2180 | (message "Local rules saved in `smie-config'") | |
2181 | smie-config--buffer-local) | |
2182 | ((y-or-n-p "Replace the existing mode's config? ") | |
2183 | (message "Mode rules replaced in `smie-config'") | |
2184 | smie-config--buffer-local) | |
2185 | ((y-or-n-p "Merge with existing mode's config? ") | |
2186 | (message "Mode rules adjusted in `smie-config'") | |
2187 | (append smie-config--buffer-local (cdr existing))) | |
2188 | (t (error "Abort"))))) | |
2189 | (if existing | |
2190 | (setcdr existing config) | |
2191 | (push (cons major-mode config) smie-config)) | |
2192 | (setq smie-config--mode-local config) | |
2193 | (kill-local-variable smie-config--buffer-local) | |
2194 | (customize-mark-as-set 'smie-config))))) | |
7f925a67 SM |
2195 | |
2196 | (provide 'smie) | |
2197 | ;;; smie.el ends here |