Remove some `toggle-read-only' warnings.
[bpt/emacs.git] / lisp / emacs-lisp / smie.el
CommitLineData
ba83908c 1;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*-
7f925a67 2
acaf905b 3;; Copyright (C) 2010-2012 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
7f925a67
SM
124(eval-when-compile (require 'cl))
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
SM
157(defun smie-set-prec2tab (table x y val &optional override)
158 (assert (and x y))
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
SM
168 (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))
169 (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.
175PRECS should be a list, sorted by precedence (e.g. \"+\" will
176come before \"*\"), of elements of the form \(left OP ...)
177or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in
178one 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.
215BNF is a list of nonterminal definitions of the form:
216 \(NONTERM RHS1 RHS2 ...)
217where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals.
218Not 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).
224Additionally, 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\").
231Conflicts can be resolved via RESOLVERS, which is a list of elements that can
232be 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))
271 (pushnew (car rhs) first-ops)
272 (pushnew (car rhs) first-nts)
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)))
7f925a67
SM
285 (pushnew (cadr rhs) first-ops)))
286 (let ((shr (reverse rhs)))
287 (if (not (member (car shr) nts))
288 (pushnew (car shr) last-ops)
289 (pushnew (car shr) last-nts)
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)))
7f925a67
SM
294 (pushnew (cadr shr) last-ops)))))
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)
310 (push op (cdr first-ops))))))))
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)
321 (push op (cdr last-ops))))))))
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.
408The return value is in the same form as `smie-closer-alist'.
409NO-INNERS if non-nil means that inner keywords will be excluded
410from 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)
419 (pushnew (cons (car rhs) last) alist :test #'equal)))
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)
424 (pushnew (cons (car rhs) term) alist :test #'equal)))))))
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 441Each 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.
462CSTS 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)))
486 (assert res)
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
501;; ((< left right) (assert (eq v '<)))
502;; ((> left right) (assert (eq v '>)))
503;; (t (assert (eq v '=))))))))
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.
509PREC2 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 ())
517 (eqs ())
518 tmp x y)
519 ;; From `prec2' we construct a list of constraints between
520 ;; variables (aka "precedence levels"). These can be either
521 ;; equality constraints (in `eqs') or `<' constraints (in `csts').
522 (maphash (lambda (k v)
523 (when (consp k)
524 (if (setq tmp (assoc (car k) table))
525 (setq x (cddr tmp))
526 (setq x (cons nil nil))
527 (push (cons (car k) (cons nil x)) table))
528 (if (setq tmp (assoc (cdr k) table))
529 (setq y (cdr tmp))
530 (setq y (cons nil (cons nil nil)))
531 (push (cons (cdr k) y) table))
532 (ecase v
533 (= (push (cons x y) eqs))
534 (< (push (cons x y) csts))
535 (> (push (cons y x) csts)))))
536 prec2)
537 ;; First process the equality constraints.
538 (let ((eqs eqs))
539 (while eqs
540 (let ((from (caar eqs))
541 (to (cdar eqs)))
542 (setq eqs (cdr eqs))
543 (if (eq to from)
09ffa822 544 nil ;Nothing to do.
7f925a67
SM
545 (dolist (other-eq eqs)
546 (if (eq from (cdr other-eq)) (setcdr other-eq to))
547 (when (eq from (car other-eq))
548 ;; This can happen because of `assoc' settings in precs
549 ;; or because of a rhs like ("op" foo "op").
550 (setcar other-eq to)))
551 (dolist (cst csts)
552 (if (eq from (cdr cst)) (setcdr cst to))
553 (if (eq from (car cst)) (setcar cst to)))))))
554 ;; Then eliminate trivial constraints iteratively.
555 (let ((i 0))
556 (while csts
557 (let ((rhvs (mapcar 'cdr csts))
558 (progress nil))
559 (dolist (cst csts)
560 (unless (memq (car cst) rhvs)
561 (setq progress t)
562 ;; We could give each var in a given iteration the same value,
563 ;; but we can also give them arbitrarily different values.
564 ;; Basically, these are vars between which there is no
565 ;; constraint (neither equality nor inequality), so
566 ;; anything will do.
567 ;; We give them arbitrary values, which means that we
568 ;; replace the "no constraint" case with either > or <
569 ;; but not =. The reason we do that is so as to try and
570 ;; distinguish associative operators (which will have
571 ;; left = right).
572 (unless (caar cst)
573 (setcar (car cst) i)
10b40d2e 574 ;; (smie-check-grammar table prec2 'step1)
7f925a67
SM
575 (incf i))
576 (setq csts (delq cst csts))))
577 (unless progress
578 (error "Can't resolve the precedence cycle: %s"
579 (smie-debug--describe-cycle
580 table (smie-debug--prec2-cycle csts)))))
581 (incf i 10))
e4769531 582 ;; Propagate equality constraints back to their sources.
7f925a67 583 (dolist (eq (nreverse eqs))
10b40d2e
SM
584 (when (null (cadr eq))
585 ;; There's an equality constraint, but we still haven't given
586 ;; it a value: that means it binds tighter than anything else,
587 ;; and it can't be an opener/closer (those don't have equality
588 ;; constraints).
589 ;; So set it here rather than below since doing it below
590 ;; makes it more difficult to obey the equality constraints.
591 (setcar (cdr eq) i)
592 (incf i))
593 (assert (or (null (caar eq)) (eq (caar eq) (cadr eq))))
594 (setcar (car eq) (cadr eq))
595 ;; (smie-check-grammar table prec2 'step2)
596 )
09ffa822
SM
597 ;; Finally, fill in the remaining vars (which did not appear on the
598 ;; left side of any < constraint).
599 (dolist (x table)
600 (unless (nth 1 x)
601 (setf (nth 1 x) i)
602 (incf i)) ;See other (incf i) above.
603 (unless (nth 2 x)
604 (setf (nth 2 x) i)
605 (incf i)))) ;See other (incf i) above.
606 ;; Mark closers and openers.
607 (dolist (x (gethash :smie-open/close-alist prec2))
608 (let* ((token (car x))
609 (cons (case (cdr x)
610 (closer (cddr (assoc token table)))
611 (opener (cdr (assoc token table))))))
612 (assert (numberp (car cons)))
613 (setf (car cons) (list (car cons)))))
7f925a67
SM
614 (let ((ca (gethash :smie-closer-alist prec2)))
615 (when ca (push (cons :smie-closer-alist ca) table)))
10b40d2e 616 ;; (smie-check-grammar table prec2 'step3)
7f925a67
SM
617 table))
618
619;;; Parsing using a precedence level table.
620
621(defvar smie-grammar 'unset
622 "List of token parsing info.
623This list is normally built by `smie-prec2->grammar'.
624Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
625Parsing is done using an operator precedence parser.
e2f454c4 626LEFT-LEVEL and RIGHT-LEVEL can be either numbers or a list, where a list
7f925a67 627means that this operator does not bind on the corresponding side,
e2f454c4 628e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like
7f925a67
SM
629an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something
630like a close-paren.")
631
632(defvar smie-forward-token-function 'smie-default-forward-token
633 "Function to scan forward for the next token.
634Called with no argument should return a token and move to its end.
635If no token is found, return nil or the empty string.
636It can return nil when bumping into a parenthesis, which lets SMIE
637use syntax-tables to handle them in efficient C code.")
638
639(defvar smie-backward-token-function 'smie-default-backward-token
640 "Function to scan backward the previous token.
641Same calling convention as `smie-forward-token-function' except
642it should move backward to the beginning of the previous token.")
643
644(defalias 'smie-op-left 'car)
645(defalias 'smie-op-right 'cadr)
646
647(defun smie-default-backward-token ()
648 (forward-comment (- (point)))
649 (buffer-substring-no-properties
650 (point)
651 (progn (if (zerop (skip-syntax-backward "."))
652 (skip-syntax-backward "w_'"))
653 (point))))
654
655(defun smie-default-forward-token ()
656 (forward-comment (point-max))
657 (buffer-substring-no-properties
658 (point)
659 (progn (if (zerop (skip-syntax-forward "."))
660 (skip-syntax-forward "w_'"))
661 (point))))
662
663(defun smie--associative-p (toklevels)
664 ;; in "a + b + c" we want to stop at each +, but in
665 ;; "if a then b elsif c then d else c" we don't want to stop at each keyword.
666 ;; To distinguish the two cases, we made smie-prec2->grammar choose
667 ;; different levels for each part of "if a then b else c", so that
668 ;; by checking if the left-level is equal to the right level, we can
669 ;; figure out that it's an associative operator.
670 ;; This is not 100% foolproof, tho, since the "elsif" will have to have
671 ;; equal left and right levels (since it's optional), so smie-next-sexp
672 ;; has to be careful to distinguish those different cases.
673 (eq (smie-op-left toklevels) (smie-op-right toklevels)))
674
675(defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp)
676 "Skip over one sexp.
677NEXT-TOKEN is a function of no argument that moves forward by one
678token (after skipping comments if needed) and returns it.
679NEXT-SEXP is a lower-level function to skip one sexp.
680OP-FORW is the accessor to the forward level of the level data.
681OP-BACK is the accessor to the backward level of the level data.
682HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
683first token we see is an operator, skip over its left-hand-side argument.
09ffa822
SM
684HALFSEXP can also be a token, in which case it means to parse as if
685we had just successfully passed this token.
7f925a67
SM
686Possible return values:
687 (FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level
688 is too high. FORW-LEVEL is the forw-level of TOKEN,
689 POS is its start position in the buffer.
690 (t POS TOKEN): same thing when we bump on the wrong side of a paren.
691 (nil POS TOKEN): we skipped over a paren-like pair.
692 nil: we skipped over an identifier, matched parentheses, ..."
693 (catch 'return
09ffa822
SM
694 (let ((levels
695 (if (stringp halfsexp)
696 (prog1 (list (cdr (assoc halfsexp smie-grammar)))
697 (setq halfsexp nil)))))
7f925a67
SM
698 (while
699 (let* ((pos (point))
700 (token (funcall next-token))
701 (toklevels (cdr (assoc token smie-grammar))))
702 (cond
703 ((null toklevels)
704 (when (zerop (length token))
705 (condition-case err
706 (progn (goto-char pos) (funcall next-sexp 1) nil)
707 (scan-error (throw 'return
708 (list t (caddr err)
709 (buffer-substring-no-properties
710 (caddr err)
711 (+ (caddr err)
712 (if (< (point) (caddr err))
713 -1 1)))))))
714 (if (eq pos (point))
715 ;; We did not move, so let's abort the loop.
716 (throw 'return (list t (point))))))
e2f454c4 717 ((not (numberp (funcall op-back toklevels)))
7f925a67 718 ;; A token like a paren-close.
e2f454c4
SM
719 (assert (numberp ; Otherwise, why mention it in smie-grammar.
720 (funcall op-forw toklevels)))
7f925a67
SM
721 (push toklevels levels))
722 (t
723 (while (and levels (< (funcall op-back toklevels)
724 (funcall op-forw (car levels))))
725 (setq levels (cdr levels)))
726 (cond
727 ((null levels)
e2f454c4 728 (if (and halfsexp (numberp (funcall op-forw toklevels)))
7f925a67
SM
729 (push toklevels levels)
730 (throw 'return
731 (prog1 (list (or (car toklevels) t) (point) token)
732 (goto-char pos)))))
733 (t
734 (let ((lastlevels levels))
735 (if (and levels (= (funcall op-back toklevels)
736 (funcall op-forw (car levels))))
737 (setq levels (cdr levels)))
738 ;; We may have found a match for the previously pending
739 ;; operator. Is this the end?
740 (cond
741 ;; Keep looking as long as we haven't matched the
742 ;; topmost operator.
743 (levels
2ad52c60
SM
744 (cond
745 ((numberp (funcall op-forw toklevels))
746 (push toklevels levels))
747 ;; FIXME: For some languages, we can express the grammar
748 ;; OK, but next-sexp doesn't stop where we'd want it to.
749 ;; E.g. in SML, we'd want to stop right in front of
750 ;; "local" if we're scanning (both forward and backward)
751 ;; from a "val/fun/..." at the same level.
752 ;; Same for Pascal/Modula2's "procedure" w.r.t
753 ;; "type/var/const".
754 ;;
755 ;; ((and (functionp (cadr (funcall op-forw toklevels)))
756 ;; (funcall (cadr (funcall op-forw toklevels))
757 ;; levels))
758 ;; (setq levels nil))
759 ))
7f925a67
SM
760 ;; We matched the topmost operator. If the new operator
761 ;; is the last in the corresponding BNF rule, we're done.
e2f454c4 762 ((not (numberp (funcall op-forw toklevels)))
7f925a67
SM
763 ;; It is the last element, let's stop here.
764 (throw 'return (list nil (point) token)))
765 ;; If the new operator is not the last in the BNF rule,
7bea8c7a 766 ;; and is not associative, it's one of the inner operators
7f925a67
SM
767 ;; (like the "in" in "let .. in .. end"), so keep looking.
768 ((not (smie--associative-p toklevels))
769 (push toklevels levels))
770 ;; The new operator is associative. Two cases:
771 ;; - it's really just an associative operator (like + or ;)
772 ;; in which case we should have stopped right before.
773 ((and lastlevels
774 (smie--associative-p (car lastlevels)))
775 (throw 'return
776 (prog1 (list (or (car toklevels) t) (point) token)
777 (goto-char pos))))
778 ;; - it's an associative operator within a larger construct
779 ;; (e.g. an "elsif"), so we should just ignore it and keep
780 ;; looking for the closing element.
781 (t (setq levels lastlevels))))))))
782 levels)
783 (setq halfsexp nil)))))
784
785(defun smie-backward-sexp (&optional halfsexp)
786 "Skip over one sexp.
787HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
788first token we see is an operator, skip over its left-hand-side argument.
09ffa822
SM
789HALFSEXP can also be a token, in which case we should skip the text
790assuming it is the left-hand-side argument of that token.
7f925a67
SM
791Possible return values:
792 (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level
793 is too high. LEFT-LEVEL is the left-level of TOKEN,
794 POS is its start position in the buffer.
795 (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
796 (nil POS TOKEN): we skipped over a paren-like pair.
797 nil: we skipped over an identifier, matched parentheses, ..."
798 (smie-next-sexp
799 (indirect-function smie-backward-token-function)
800 (indirect-function 'backward-sexp)
801 (indirect-function 'smie-op-left)
802 (indirect-function 'smie-op-right)
803 halfsexp))
804
805(defun smie-forward-sexp (&optional halfsexp)
806 "Skip over one sexp.
807HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
09ffa822
SM
808first token we see is an operator, skip over its right-hand-side argument.
809HALFSEXP can also be a token, in which case we should skip the text
810assuming it is the right-hand-side argument of that token.
7f925a67
SM
811Possible return values:
812 (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
813 is too high. RIGHT-LEVEL is the right-level of TOKEN,
814 POS is its end position in the buffer.
815 (t POS TOKEN): same thing but for an open-paren or the beginning of buffer.
816 (nil POS TOKEN): we skipped over a paren-like pair.
817 nil: we skipped over an identifier, matched parentheses, ..."
818 (smie-next-sexp
819 (indirect-function smie-forward-token-function)
820 (indirect-function 'forward-sexp)
821 (indirect-function 'smie-op-right)
822 (indirect-function 'smie-op-left)
823 halfsexp))
824
09e80d9f 825;;; Miscellaneous commands using the precedence parser.
7f925a67
SM
826
827(defun smie-backward-sexp-command (&optional n)
828 "Move backward through N logical elements."
829 (interactive "^p")
830 (smie-forward-sexp-command (- n)))
831
832(defun smie-forward-sexp-command (&optional n)
833 "Move forward through N logical elements."
834 (interactive "^p")
835 (let ((forw (> n 0))
836 (forward-sexp-function nil))
837 (while (/= n 0)
838 (setq n (- n (if forw 1 -1)))
839 (let ((pos (point))
840 (res (if forw
841 (smie-forward-sexp 'halfsexp)
842 (smie-backward-sexp 'halfsexp))))
843 (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp))))
844 (signal 'scan-error
845 (list "Containing expression ends prematurely"
846 (cadr res) (cadr res)))
847 nil)))))
848
849(defvar smie-closer-alist nil
850 "Alist giving the closer corresponding to an opener.")
851
852(defun smie-close-block ()
853 "Close the closest surrounding block."
854 (interactive)
855 (let ((closer
856 (save-excursion
857 (backward-up-list 1)
858 (if (looking-at "\\s(")
859 (string (cdr (syntax-after (point))))
860 (let* ((open (funcall smie-forward-token-function))
861 (closer (cdr (assoc open smie-closer-alist)))
862 (levels (list (assoc open smie-grammar)))
863 (seen '())
864 (found '()))
865 (cond
866 ;; Even if we improve the auto-computation of closers,
867 ;; there are still cases where we need manual
868 ;; intervention, e.g. for Octave's use of `until'
869 ;; as a pseudo-closer of `do'.
870 (closer)
e2f454c4 871 ((or (equal levels '(nil)) (numberp (nth 1 (car levels))))
7f925a67
SM
872 (error "Doesn't look like a block"))
873 (t
874 ;; Now that smie-setup automatically sets smie-closer-alist
875 ;; from the BNF, this is not really needed any more.
876 (while levels
877 (let ((level (pop levels)))
878 (dolist (other smie-grammar)
879 (when (and (eq (nth 2 level) (nth 1 other))
880 (not (memq other seen)))
881 (push other seen)
e2f454c4 882 (if (numberp (nth 2 other))
7f925a67
SM
883 (push other levels)
884 (push (car other) found))))))
885 (cond
886 ((null found) (error "No known closer for opener %s" open))
09ffa822 887 ;; What should we do if there are various closers?
7f925a67
SM
888 (t (car found))))))))))
889 (unless (save-excursion (skip-chars-backward " \t") (bolp))
890 (newline))
891 (insert closer)
892 (if (save-excursion (skip-chars-forward " \t") (eolp))
893 (indent-according-to-mode)
894 (reindent-then-newline-and-indent))))
895
896(defun smie-down-list (&optional arg)
897 "Move forward down one level paren-like blocks. Like `down-list'.
898With argument ARG, do this that many times.
899A negative argument means move backward but still go down a level.
900This command assumes point is not in a string or comment."
901 (interactive "p")
902 (let ((start (point))
903 (inc (if (< arg 0) -1 1))
904 (offset (if (< arg 0) 1 0))
905 (next-token (if (< arg 0)
906 smie-backward-token-function
907 smie-forward-token-function)))
908 (while (/= arg 0)
909 (setq arg (- arg inc))
910 (while
911 (let* ((pos (point))
912 (token (funcall next-token))
913 (levels (assoc token smie-grammar)))
914 (cond
915 ((zerop (length token))
916 (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point)))
917 (looking-at "\\s(\\|\\s)"))
918 ;; Go back to `start' in case of an error. This presumes
919 ;; none of the token we've found until now include a ( or ).
920 (progn (goto-char start) (down-list inc) nil)
921 (forward-sexp inc)
922 (/= (point) pos)))
e2f454c4
SM
923 ((and levels (not (numberp (nth (+ 1 offset) levels)))) nil)
924 ((and levels (not (numberp (nth (- 2 offset) levels))))
7f925a67
SM
925 (let ((end (point)))
926 (goto-char start)
927 (signal 'scan-error
928 (list "Containing expression ends prematurely"
929 pos end))))
930 (t)))))))
931
932(defvar smie-blink-matching-triggers '(?\s ?\n)
933 "Chars which might trigger `blink-matching-open'.
934These can include the final chars of end-tokens, or chars that are
935typically inserted right after an end token.
936I.e. a good choice can be:
937 (delete-dups
938 (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw)))))
939 smie-closer-alist))")
940
941(defcustom smie-blink-matching-inners t
942 "Whether SMIE should blink to matching opener for inner keywords.
943If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
944 :type 'boolean
945 :group 'smie)
946
947(defun smie-blink-matching-check (start end)
948 (save-excursion
949 (goto-char end)
950 (let ((ender (funcall smie-backward-token-function)))
951 (cond
952 ((not (and ender (rassoc ender smie-closer-alist)))
953 ;; This not is one of the begin..end we know how to check.
954 (blink-matching-check-mismatch start end))
955 ((not start) t)
956 ((eq t (car (rassoc ender smie-closer-alist))) nil)
957 (t
958 (goto-char start)
959 (let ((starter (funcall smie-forward-token-function)))
960 (not (member (cons starter ender) smie-closer-alist))))))))
961
962(defun smie-blink-matching-open ()
963 "Blink the matching opener when applicable.
964This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'."
965 (let ((pos (point)) ;Position after the close token.
966 token)
967 (when (and blink-matching-paren
968 smie-closer-alist ; Optimization.
969 (or (eq (char-before) last-command-event) ;; Sanity check.
970 (save-excursion
971 (or (progn (skip-chars-backward " \t")
972 (setq pos (point))
973 (eq (char-before) last-command-event))
974 (progn (skip-chars-backward " \n\t")
975 (setq pos (point))
976 (eq (char-before) last-command-event)))))
977 (memq last-command-event smie-blink-matching-triggers)
978 (not (nth 8 (syntax-ppss))))
979 (save-excursion
980 (setq token (funcall smie-backward-token-function))
981 (when (and (eq (point) (1- pos))
982 (= 1 (length token))
983 (not (rassoc token smie-closer-alist)))
984 ;; The trigger char is itself a token but is not one of the
985 ;; closers (e.g. ?\; in Octave mode), so go back to the
986 ;; previous token.
987 (setq pos (point))
988 (setq token (funcall smie-backward-token-function)))
989 (when (rassoc token smie-closer-alist)
990 ;; We're after a close token. Let's still make sure we
991 ;; didn't skip a comment to find that token.
992 (funcall smie-forward-token-function)
993 (when (and (save-excursion
994 ;; Skip the trigger char, if applicable.
995 (if (eq (char-after) last-command-event)
996 (forward-char 1))
997 (if (eq ?\n last-command-event)
998 ;; Skip any auto-indentation, if applicable.
999 (skip-chars-forward " \t"))
1000 (>= (point) pos))
1001 ;; If token ends with a trigger char, don't blink for
1002 ;; anything else than this trigger char, lest we'd blink
1003 ;; both when inserting the trigger char and when
1004 ;; inserting a subsequent trigger char like SPC.
9517f8af 1005 (or (eq (char-before) last-command-event)
7f925a67
SM
1006 (not (memq (char-before)
1007 smie-blink-matching-triggers)))
1008 (or smie-blink-matching-inners
e2f454c4 1009 (not (numberp (nth 2 (assoc token smie-grammar))))))
7f925a67
SM
1010 ;; The major mode might set blink-matching-check-function
1011 ;; buffer-locally so that interactive calls to
1012 ;; blink-matching-open work right, but let's not presume
1013 ;; that's the case.
1014 (let ((blink-matching-check-function #'smie-blink-matching-check))
1015 (blink-matching-open))))))))
1016
1017;;; The indentation engine.
1018
1019(defcustom smie-indent-basic 4
1020 "Basic amount of indentation."
1021 :type 'integer
1022 :group 'smie)
1023
1024(defvar smie-rules-function 'ignore
1025 "Function providing the indentation rules.
1026It takes two arguments METHOD and ARG where the meaning of ARG
1027and the expected return value depends on METHOD.
1028METHOD can be:
1029- :after, in which case ARG is a token and the function should return the
1030 OFFSET to use for indentation after ARG.
1031- :before, in which case ARG is a token and the function should return the
1032 OFFSET to use to indent ARG itself.
1033- :elem, in which case the function should return either:
1034 - the offset to use to indent function arguments (ARG = `arg')
1035 - the basic indentation step (ARG = `basic').
1036- :list-intro, in which case ARG is a token and the function should return
1037 non-nil if TOKEN is followed by a list of expressions (not separated by any
1038 token) rather than an expression.
1039
1040When ARG is a token, the function is called with point just before that token.
1041A return value of nil always means to fallback on the default behavior, so the
1042function should return nil for arguments it does not expect.
1043
1044OFFSET can be:
1045nil use the default indentation rule.
2ad52c60 1046\(column . COLUMN) indent to column COLUMN.
7f925a67
SM
1047NUMBER offset by NUMBER, relative to a base token
1048 which is the current token for :after and
1049 its parent for :before.
1050
1051The functions whose name starts with \"smie-rule-\" are helper functions
1052designed specifically for use in this function.")
1053
1054(defalias 'smie-rule-hanging-p 'smie-indent--hanging-p)
1055(defun smie-indent--hanging-p ()
1056 "Return non-nil if the current token is \"hanging\".
1057A hanging keyword is one that's at the end of a line except it's not at
1058the beginning of a line."
1059 (and (not (smie-indent--bolp))
1060 (save-excursion
1061 (<= (line-end-position)
1062 (progn
1063 (when (zerop (length (funcall smie-forward-token-function)))
1064 ;; Could be an open-paren.
1065 (forward-char 1))
1066 (skip-chars-forward " \t")
1067 (or (eolp)
1068 (and (looking-at comment-start-skip)
1069 (forward-comment (point-max))))
1070 (point))))))
1071
1072(defalias 'smie-rule-bolp 'smie-indent--bolp)
1073(defun smie-indent--bolp ()
1074 "Return non-nil if the current token is the first on the line."
1075 (save-excursion (skip-chars-backward " \t") (bolp)))
1076
1077;; Dynamically scoped.
1078(defvar smie--parent) (defvar smie--after) (defvar smie--token)
1079
1080(defun smie-indent--parent ()
1081 (or smie--parent
1082 (save-excursion
1083 (let* ((pos (point))
1084 (tok (funcall smie-forward-token-function)))
e2f454c4 1085 (unless (numberp (cadr (assoc tok smie-grammar)))
7f925a67
SM
1086 (goto-char pos))
1087 (setq smie--parent
9517f8af
SM
1088 (or (smie-backward-sexp 'halfsexp)
1089 (let (res)
1090 (while (null (setq res (smie-backward-sexp))))
1091 (list nil (point) (nth 2 res)))))))))
7f925a67
SM
1092
1093(defun smie-rule-parent-p (&rest parents)
1094 "Return non-nil if the current token's parent is among PARENTS.
1095Only meaningful when called from within `smie-rules-function'."
1096 (member (nth 2 (smie-indent--parent)) parents))
1097
1098(defun smie-rule-next-p (&rest tokens)
1099 "Return non-nil if the next token is among TOKENS.
1100Only meaningful when called from within `smie-rules-function'."
1101 (let ((next
1102 (save-excursion
1103 (unless smie--after
1104 (smie-indent-forward-token) (setq smie--after (point)))
1105 (goto-char smie--after)
1106 (smie-indent-forward-token))))
1107 (member (car next) tokens)))
1108
1109(defun smie-rule-prev-p (&rest tokens)
1110 "Return non-nil if the previous token is among TOKENS."
1111 (let ((prev (save-excursion
1112 (smie-indent-backward-token))))
1113 (member (car prev) tokens)))
1114
1115(defun smie-rule-sibling-p ()
1116 "Return non-nil if the parent is actually a sibling.
1117Only meaningful when called from within `smie-rules-function'."
1118 (eq (car (smie-indent--parent))
1119 (cadr (assoc smie--token smie-grammar))))
1120
1121(defun smie-rule-parent (&optional offset)
1122 "Align with parent.
1123If non-nil, OFFSET should be an integer giving an additional offset to apply.
1124Only meaningful when called from within `smie-rules-function'."
1125 (save-excursion
1126 (goto-char (cadr (smie-indent--parent)))
1127 (cons 'column
1128 (+ (or offset 0)
7bea8c7a
SM
1129 ;; Use smie-indent-virtual when indenting relative to an opener:
1130 ;; this will also by default use current-column unless
1131 ;; that opener is hanging, but will additionally consult
1132 ;; rules-function, so it gives it a chance to tweak
1133 ;; indentation (e.g. by forcing indentation relative to
1134 ;; its own parent, as in fn a => fn b => fn c =>).
e2f454c4 1135 (if (or (listp (car smie--parent)) (smie-indent--hanging-p))
7bea8c7a 1136 (smie-indent-virtual) (current-column))))))
7f925a67
SM
1137
1138(defvar smie-rule-separator-outdent 2)
1139
1140(defun smie-indent--separator-outdent ()
1141 ;; FIXME: Here we actually have several reasonable behaviors.
1142 ;; E.g. for a parent token of "FOO" and a separator ";" we may want to:
1143 ;; 1- left-align ; with FOO.
1144 ;; 2- right-align ; with FOO.
1145 ;; 3- align content after ; with content after FOO.
1146 ;; 4- align content plus add/remove spaces so as to align ; with FOO.
1147 ;; Currently, we try to align the contents (option 3) which actually behaves
1148 ;; just like option 2 (if the number of spaces after FOO and ; is equal).
1149 (let ((afterpos (save-excursion
1150 (let ((tok (funcall smie-forward-token-function)))
1151 (unless tok
1152 (with-demoted-errors
1153 (error "smie-rule-separator: can't skip token %s"
1154 smie--token))))
1155 (skip-chars-forward " ")
1156 (unless (eolp) (point)))))
1157 (or (and afterpos
1158 ;; This should always be true, unless
1159 ;; smie-forward-token-function skipped a \n.
1160 (< afterpos (line-end-position))
1161 (- afterpos (point)))
1162 smie-rule-separator-outdent)))
1163
1164(defun smie-rule-separator (method)
1165 "Indent current token as a \"separator\".
1166By \"separator\", we mean here a token whose sole purpose is to separate
1167various elements within some enclosing syntactic construct, and which does
1168not have any semantic significance in itself (i.e. it would typically no exist
1169as a node in an abstract syntax tree).
1170Such a token is expected to have an associative syntax and be closely tied
1171to its syntactic parent. Typical examples are \",\" in lists of arguments
1172\(enclosed inside parentheses), or \";\" in sequences of instructions (enclosed
1173in a {..} or begin..end block).
1174METHOD should be the method name that was passed to `smie-rules-function'.
1175Only meaningful when called from within `smie-rules-function'."
1176 ;; FIXME: The code below works OK for cases where the separators
1177 ;; are placed consistently always at beginning or always at the end,
1178 ;; but not if some are at the beginning and others are at the end.
1179 ;; I.e. it gets confused in cases such as:
1180 ;; ( a
1181 ;; , a,
1182 ;; b
1183 ;; , c,
1184 ;; d
1185 ;; )
1186 ;;
1187 ;; Assuming token is associative, the default rule for associative
1188 ;; tokens (which assumes an infix operator) works fine for many cases.
1189 ;; We mostly need to take care of the case where token is at beginning of
1190 ;; line, in which case we want to align it with its enclosing parent.
1191 (cond
1192 ((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p)))
7bea8c7a 1193 (let ((parent-col (cdr (smie-rule-parent)))
7f925a67
SM
1194 (parent-pos-col ;FIXME: we knew this when computing smie--parent.
1195 (save-excursion
1196 (goto-char (cadr smie--parent))
1197 (smie-indent-forward-token)
1198 (forward-comment (point-max))
1199 (current-column))))
1200 (cons 'column
1201 (max parent-col
1202 (min parent-pos-col
1203 (- parent-pos-col (smie-indent--separator-outdent)))))))
1204 ((and (eq method :after) (smie-indent--bolp))
1205 (smie-indent--separator-outdent))))
1206
1207(defun smie-indent--offset (elem)
1208 (or (funcall smie-rules-function :elem elem)
1209 (if (not (eq elem 'basic))
1210 (funcall smie-rules-function :elem 'basic))
1211 smie-indent-basic))
1212
1213(defun smie-indent--rule (method token
1214 ;; FIXME: Too many parameters.
1215 &optional after parent base-pos)
1216 "Compute indentation column according to `indent-rule-functions'.
1217METHOD and TOKEN are passed to `indent-rule-functions'.
1218AFTER is the position after TOKEN, if known.
1219PARENT is the parent info returned by `smie-backward-sexp', if known.
1220BASE-POS is the position relative to which offsets should be applied."
1221 ;; This is currently called in 3 cases:
1222 ;; - :before opener, where rest=nil but base-pos could as well be parent.
1223 ;; - :before other, where
1224 ;; ; after=nil
1225 ;; ; parent is set
1226 ;; ; base-pos=parent
1227 ;; - :after tok, where
1228 ;; ; after is set; parent=nil; base-pos=point;
1229 (save-excursion
1230 (let ((offset
1231 (let ((smie--parent parent)
1232 (smie--token token)
1233 (smie--after after))
1234 (funcall smie-rules-function method token))))
1235 (cond
1236 ((not offset) nil)
1237 ((eq (car-safe offset) 'column) (cdr offset))
1238 ((integerp offset)
1239 (+ offset
1240 (if (null base-pos) 0
1241 (goto-char base-pos)
7bea8c7a
SM
1242 ;; Use smie-indent-virtual when indenting relative to an opener:
1243 ;; this will also by default use current-column unless
1244 ;; that opener is hanging, but will additionally consult
1245 ;; rules-function, so it gives it a chance to tweak indentation
1246 ;; (e.g. by forcing indentation relative to its own parent, as in
1247 ;; fn a => fn b => fn c =>).
1248 ;; When parent==nil it doesn't matter because the only case
1249 ;; where it's really used is when the base-pos is hanging anyway.
1250 (if (or (and parent (null (car parent)))
1251 (smie-indent--hanging-p))
7f925a67
SM
1252 (smie-indent-virtual) (current-column)))))
1253 (t (error "Unknown indentation offset %s" offset))))))
1254
1255(defun smie-indent-forward-token ()
1256 "Skip token forward and return it, along with its levels."
1257 (let ((tok (funcall smie-forward-token-function)))
1258 (cond
1259 ((< 0 (length tok)) (assoc tok smie-grammar))
1260 ((looking-at "\\s(\\|\\s)\\(\\)")
1261 (forward-char 1)
1262 (cons (buffer-substring (1- (point)) (point))
1263 (if (match-end 1) '(0 nil) '(nil 0)))))))
1264
1265(defun smie-indent-backward-token ()
1266 "Skip token backward and return it, along with its levels."
1267 (let ((tok (funcall smie-backward-token-function))
1268 class)
1269 (cond
1270 ((< 0 (length tok)) (assoc tok smie-grammar))
1271 ;; 4 == open paren syntax, 5 == close.
1272 ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5))
1273 (forward-char -1)
1274 (cons (buffer-substring (point) (1+ (point)))
1275 (if (eq class 4) '(nil 0) '(0 nil)))))))
1276
1277(defun smie-indent-virtual ()
1278 ;; We used to take an optional arg (with value :not-hanging) to specify that
1279 ;; we should only use (smie-indent-calculate) if we're looking at a hanging
1280 ;; keyword. This was a bad idea, because the virtual indent of a position
1281 ;; should not depend on the caller, since it leads to situations where two
1282 ;; dependent indentations get indented differently.
1283 "Compute the virtual indentation to use for point.
1284This is used when we're not trying to indent point but just
1285need to compute the column at which point should be indented
1286in order to figure out the indentation of some other (further down) point."
1287 ;; Trust pre-existing indentation on other lines.
1288 (if (smie-indent--bolp) (current-column) (smie-indent-calculate)))
1289
1290(defun smie-indent-fixindent ()
1291 ;; Obey the `fixindent' special comment.
1292 (and (smie-indent--bolp)
1293 (save-excursion
1294 (comment-normalize-vars)
1295 (re-search-forward (concat comment-start-skip
1296 "fixindent"
1297 comment-end-skip)
1298 ;; 1+ to account for the \n comment termination.
1299 (1+ (line-end-position)) t))
1300 (current-column)))
1301
1302(defun smie-indent-bob ()
1303 ;; Start the file at column 0.
1304 (save-excursion
1305 (forward-comment (- (point)))
1306 (if (bobp) 0)))
1307
1308(defun smie-indent-close ()
1309 ;; Align close paren with opening paren.
1310 (save-excursion
1311 ;; (forward-comment (point-max))
1312 (when (looking-at "\\s)")
1313 (while (not (zerop (skip-syntax-forward ")")))
1314 (skip-chars-forward " \t"))
1315 (condition-case nil
1316 (progn
1317 (backward-sexp 1)
1318 (smie-indent-virtual)) ;:not-hanging
1319 (scan-error nil)))))
1320
09ffa822
SM
1321(defun smie-indent-keyword (&optional token)
1322 "Indent point based on the token that follows it immediately.
1323If TOKEN is non-nil, assume that that is the token that follows point.
1324Returns either a column number or nil if it considers that indentation
1325should not be computed on the basis of the following token."
7f925a67
SM
1326 (save-excursion
1327 (let* ((pos (point))
09ffa822
SM
1328 (toklevels
1329 (if token
1330 (assoc token smie-grammar)
1331 (let* ((res (smie-indent-forward-token)))
1332 ;; Ignore tokens on subsequent lines.
1333 (if (and (< pos (line-beginning-position))
1334 ;; Make sure `token' also *starts* on another line.
1335 (save-excursion
1336 (smie-indent-backward-token)
1337 (< pos (line-beginning-position))))
1338 nil
1339 (goto-char pos)
1340 res)))))
1341 (setq token (pop toklevels))
e2f454c4 1342 (cond
09ffa822 1343 ((null (cdr toklevels)) nil) ;Not a keyword.
e2f454c4 1344 ((not (numberp (car toklevels)))
09ffa822
SM
1345 ;; Different cases:
1346 ;; - smie-indent--bolp: "indent according to others".
1347 ;; - common hanging: "indent according to others".
1348 ;; - SML-let hanging: "indent like parent".
1349 ;; - if-after-else: "indent-like parent".
1350 ;; - middle-of-line: "trust current position".
1351 (cond
1352 ((smie-indent--rule :before token))
1353 ((smie-indent--bolp) ;I.e. non-virtual indent.
1354 ;; For an open-paren-like thingy at BOL, always indent only
1355 ;; based on other rules (typically smie-indent-after-keyword).
1356 nil)
1357 (t
1358 ;; By default use point unless we're hanging.
1359 (unless (smie-indent--hanging-p) (current-column)))))
e2f454c4 1360 (t
7f925a67 1361 ;; FIXME: This still looks too much like black magic!!
09ffa822 1362 (let* ((parent (smie-backward-sexp token)))
7f925a67
SM
1363 ;; Different behaviors:
1364 ;; - align with parent.
1365 ;; - parent + offset.
1366 ;; - after parent's column + offset (actually, after or before
1367 ;; depending on where backward-sexp stopped).
1368 ;; ? let it drop to some other indentation function (almost never).
1369 ;; ? parent + offset + parent's own offset.
1370 ;; Different cases:
1371 ;; - bump into a same-level operator.
1372 ;; - bump into a specific known parent.
1373 ;; - find a matching open-paren thingy.
1374 ;; - bump into some random parent.
1375 ;; ? borderline case (almost never).
1376 ;; ? bump immediately into a parent.
1377 (cond
1378 ((not (or (< (point) pos)
1379 (and (cadr parent) (< (cadr parent) pos))))
1380 ;; If we didn't move at all, that means we didn't really skip
1381 ;; what we wanted. Should almost never happen, other than
1382 ;; maybe when an infix or close-paren is at the beginning
1383 ;; of a buffer.
1384 nil)
1385 ((save-excursion
1386 (goto-char pos)
1387 (smie-indent--rule :before token nil parent (cadr parent))))
1388 ((eq (car parent) (car toklevels))
1389 ;; We bumped into a same-level operator; align with it.
1390 (if (and (smie-indent--bolp) (/= (point) pos)
1391 (save-excursion
1392 (goto-char (goto-char (cadr parent)))
1393 (not (smie-indent--bolp))))
1394 ;; If the parent is at EOL and its children are indented like
1395 ;; itself, then we can just obey the indentation chosen for the
1396 ;; child.
1397 ;; This is important for operators like ";" which
1398 ;; are usually at EOL (and have an offset of 0): otherwise we'd
1399 ;; always go back over all the statements, which is
1400 ;; a performance problem and would also mean that fixindents
1401 ;; in the middle of such a sequence would be ignored.
1402 ;;
1403 ;; This is a delicate point!
1404 ;; Even if the offset is not 0, we could follow the same logic
1405 ;; and subtract the offset from the child's indentation.
1406 ;; But that would more often be a bad idea: OT1H we generally
1407 ;; want to reuse the closest similar indentation point, so that
1408 ;; the user's choice (or the fixindents) are obeyed. But OTOH
1409 ;; we don't want this to affect "unrelated" parts of the code.
1410 ;; E.g. a fixindent in the body of a "begin..end" should not
1411 ;; affect the indentation of the "end".
1412 (current-column)
1413 (goto-char (cadr parent))
1414 ;; Don't use (smie-indent-virtual :not-hanging) here, because we
1415 ;; want to jump back over a sequence of same-level ops such as
1416 ;; a -> b -> c
1417 ;; -> d
1418 ;; So as to align with the earliest appropriate place.
1419 (smie-indent-virtual)))
1420 (t
1421 (if (and (= (point) pos) (smie-indent--bolp))
1422 ;; Since we started at BOL, we're not computing a virtual
1423 ;; indentation, and we're still at the starting point, so
1424 ;; we can't use `current-column' which would cause
1425 ;; indentation to depend on itself and we can't use
1426 ;; smie-indent-virtual since that would be an inf-loop.
1427 nil
1428 ;; In indent-keyword, if we're indenting `then' wrt `if', we
1429 ;; want to use indent-virtual rather than use just
1430 ;; current-column, so that we can apply the (:before . "if")
1431 ;; rule which does the "else if" dance in SML. But in other
1432 ;; cases, we do not want to use indent-virtual (e.g. indentation
1433 ;; of "*" w.r.t "+", or ";" wrt "("). We could just always use
1434 ;; indent-virtual and then have indent-rules say explicitly to
1435 ;; use `point' after things like "(" or "+" when they're not at
1436 ;; EOL, but you'd end up with lots of those rules.
1437 ;; So we use a heuristic here, which is that we only use virtual
1438 ;; if the parent is tightly linked to the child token (they're
1439 ;; part of the same BNF rule).
e2f454c4 1440 (if (car parent) (current-column) (smie-indent-virtual)))))))))))
7f925a67
SM
1441
1442(defun smie-indent-comment ()
1443 "Compute indentation of a comment."
1444 ;; Don't do it for virtual indentations. We should normally never be "in
1445 ;; front of a comment" when doing virtual-indentation anyway. And if we are
1446 ;; (as can happen in octave-mode), moving forward can lead to inf-loops.
1447 (and (smie-indent--bolp)
1448 (let ((pos (point)))
1449 (save-excursion
1450 (beginning-of-line)
1451 (and (re-search-forward comment-start-skip (line-end-position) t)
1452 (eq pos (or (match-end 1) (match-beginning 0))))))
1453 (save-excursion
1454 (forward-comment (point-max))
1455 (skip-chars-forward " \t\r\n")
1456 (smie-indent-calculate))))
1457
1458(defun smie-indent-comment-continue ()
1459 ;; indentation of comment-continue lines.
1460 (let ((continue (and comment-continue
1461 (comment-string-strip comment-continue t t))))
1462 (and (< 0 (length continue))
1463 (looking-at (regexp-quote continue)) (nth 4 (syntax-ppss))
1464 (let ((ppss (syntax-ppss)))
1465 (save-excursion
1466 (forward-line -1)
1467 (if (<= (point) (nth 8 ppss))
1468 (progn (goto-char (1+ (nth 8 ppss))) (current-column))
1469 (skip-chars-forward " \t")
1470 (if (looking-at (regexp-quote continue))
1471 (current-column))))))))
1472
1473(defun smie-indent-comment-close ()
1474 (and (boundp 'comment-end-skip)
1475 comment-end-skip
1476 (not (looking-at " \t*$")) ;Not just a \n comment-closer.
1477 (looking-at comment-end-skip)
7bea8c7a
SM
1478 (let ((end (match-string 0)))
1479 (and (nth 4 (syntax-ppss))
1480 (save-excursion
1481 (goto-char (nth 8 (syntax-ppss)))
1482 (and (looking-at comment-start-skip)
1483 (let ((start (match-string 0)))
1484 ;; Align the common substring between starter
1485 ;; and ender, if possible.
1486 (if (string-match "\\(.+\\).*\n\\(.*?\\)\\1"
1487 (concat start "\n" end))
1488 (+ (current-column) (match-beginning 0)
1489 (- (match-beginning 2) (match-end 2)))
1490 (current-column)))))))))
7f925a67
SM
1491
1492(defun smie-indent-comment-inside ()
1493 (and (nth 4 (syntax-ppss))
1494 'noindent))
1495
9517f8af
SM
1496(defun smie-indent-inside-string ()
1497 (and (nth 3 (syntax-ppss))
1498 'noindent))
1499
7f925a67
SM
1500(defun smie-indent-after-keyword ()
1501 ;; Indentation right after a special keyword.
1502 (save-excursion
1503 (let* ((pos (point))
1504 (toklevel (smie-indent-backward-token))
1505 (tok (car toklevel)))
1506 (cond
1507 ((null toklevel) nil)
1508 ((smie-indent--rule :after tok pos nil (point)))
1509 ;; The default indentation after a keyword/operator is
1510 ;; 0 for infix, t for prefix, and use another rule
1511 ;; for postfix.
e2f454c4
SM
1512 ((not (numberp (nth 2 toklevel))) nil) ;A closer.
1513 ((or (not (numberp (nth 1 toklevel))) ;An opener.
1514 (rassoc tok smie-closer-alist)) ;An inner.
7f925a67 1515 (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ;
e2f454c4 1516 (t (smie-indent-virtual)))))) ;An infix.
7f925a67
SM
1517
1518(defun smie-indent-exps ()
1519 ;; Indentation of sequences of simple expressions without
1520 ;; intervening keywords or operators. E.g. "a b c" or "g (balbla) f".
1521 ;; Can be a list of expressions or a function call.
1522 ;; If it's a function call, the first element is special (it's the
1523 ;; function). We distinguish function calls from mere lists of
1524 ;; expressions based on whether the preceding token is listed in
1525 ;; the `list-intro' entry of smie-indent-rules.
1526 ;;
1527 ;; TODO: to indent Lisp code, we should add a way to specify
1528 ;; particular indentation for particular args depending on the
1529 ;; function (which would require always skipping back until the
1530 ;; function).
1531 ;; TODO: to indent C code, such as "if (...) {...}" we might need
1532 ;; to add similar indentation hooks for particular positions, but
1533 ;; based on the preceding token rather than based on the first exp.
1534 (save-excursion
1535 (let ((positions nil)
1536 arg)
1537 (while (and (null (car (smie-backward-sexp)))
1538 (push (point) positions)
1539 (not (smie-indent--bolp))))
1540 (save-excursion
1541 ;; Figure out if the atom we just skipped is an argument rather
1542 ;; than a function.
1543 (setq arg
1544 (or (null (car (smie-backward-sexp)))
1545 (funcall smie-rules-function :list-intro
1546 (funcall smie-backward-token-function)))))
1547 (cond
1548 ((null positions)
1549 ;; We're the first expression of the list. In that case, the
1550 ;; indentation should be (have been) determined by its context.
1551 nil)
1552 (arg
1553 ;; There's a previous element, and it's not special (it's not
1554 ;; the function), so let's just align with that one.
1555 (goto-char (car positions))
1556 (current-column))
1557 ((cdr positions)
1558 ;; We skipped some args plus the function and bumped into something.
1559 ;; Align with the first arg.
1560 (goto-char (cadr positions))
1561 (current-column))
1562 (positions
1563 ;; We're the first arg.
1564 (goto-char (car positions))
1565 (+ (smie-indent--offset 'args)
1566 ;; We used to use (smie-indent-virtual), but that
1567 ;; doesn't seem right since it might then indent args less than
1568 ;; the function itself.
1569 (current-column)))))))
1570
1571(defvar smie-indent-functions
1572 '(smie-indent-fixindent smie-indent-bob smie-indent-close
9517f8af
SM
1573 smie-indent-comment smie-indent-comment-continue smie-indent-comment-close
1574 smie-indent-comment-inside smie-indent-inside-string
1575 smie-indent-keyword smie-indent-after-keyword
7f925a67
SM
1576 smie-indent-exps)
1577 "Functions to compute the indentation.
1578Each function is called with no argument, shouldn't move point, and should
1579return either nil if it has no opinion, or an integer representing the column
1580to which that point should be aligned, if we were to reindent it.")
1581
1582(defun smie-indent-calculate ()
1583 "Compute the indentation to use for point."
1584 (run-hook-with-args-until-success 'smie-indent-functions))
1585
1586(defun smie-indent-line ()
1587 "Indent current line using the SMIE indentation engine."
1588 (interactive)
1589 (let* ((savep (point))
1590 (indent (or (with-demoted-errors
1591 (save-excursion
1592 (forward-line 0)
1593 (skip-chars-forward " \t")
1594 (if (>= (point) savep) (setq savep nil))
1595 (or (smie-indent-calculate) 0)))
1596 0)))
1597 (if (not (numberp indent))
1598 ;; If something funny is used (e.g. `noindent'), return it.
1599 indent
1600 (if (< indent 0) (setq indent 0)) ;Just in case.
1601 (if savep
1602 (save-excursion (indent-line-to indent))
1603 (indent-line-to indent)))))
1604
3f99e6e6
SM
1605(defun smie-auto-fill ()
1606 (let ((fc (current-fill-column))
1607 (try-again nil))
1608 (while (and fc (> (current-column) fc))
1609 (cond
1610 ((not (or (nth 8 (save-excursion
1611 (syntax-ppss (line-beginning-position))))
1612 (nth 8 (syntax-ppss))))
1613 (save-excursion
1614 (beginning-of-line)
1615 (smie-indent-forward-token)
1616 (let ((bsf (point))
1617 (gain 0)
1618 curcol)
1619 (while (<= (setq curcol (current-column)) fc)
1620 ;; FIXME? `smie-indent-calculate' can (and often will)
1621 ;; return a result that actually depends on the presence/absence
1622 ;; of a newline, so the gain computed here may not be accurate,
1623 ;; but in practice it seems to works well enough.
1624 (let* ((newcol (smie-indent-calculate))
1625 (newgain (- curcol newcol)))
1626 (when (> newgain gain)
1627 (setq gain newgain)
1628 (setq bsf (point))))
1629 (smie-indent-forward-token))
1630 (when (> gain 0)
1631 (setq try-again)
1632 (goto-char bsf)
1633 (newline-and-indent)))))
1634 (t (do-auto-fill))))))
1635
1636
7f925a67
SM
1637(defun smie-setup (grammar rules-function &rest keywords)
1638 "Setup SMIE navigation and indentation.
1639GRAMMAR is a grammar table generated by `smie-prec2->grammar'.
1640RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'.
1641KEYWORDS are additional arguments, which can use the following keywords:
1642- :forward-token FUN
1643- :backward-token FUN"
1644 (set (make-local-variable 'smie-rules-function) rules-function)
1645 (set (make-local-variable 'smie-grammar) grammar)
1646 (set (make-local-variable 'indent-line-function) 'smie-indent-line)
3f99e6e6 1647 (set (make-local-variable 'normal-auto-fill-function) 'smie-auto-fill)
7f925a67
SM
1648 (set (make-local-variable 'forward-sexp-function)
1649 'smie-forward-sexp-command)
1650 (while keywords
1651 (let ((k (pop keywords))
1652 (v (pop keywords)))
1653 (case k
1654 (:forward-token
1655 (set (make-local-variable 'smie-forward-token-function) v))
1656 (:backward-token
1657 (set (make-local-variable 'smie-backward-token-function) v))
1658 (t (message "smie-setup: ignoring unknown keyword %s" k)))))
1659 (let ((ca (cdr (assq :smie-closer-alist grammar))))
1660 (when ca
1661 (set (make-local-variable 'smie-closer-alist) ca)
1662 ;; Only needed for interactive calls to blink-matching-open.
1663 (set (make-local-variable 'blink-matching-check-function)
1664 #'smie-blink-matching-check)
1665 (add-hook 'post-self-insert-hook
1666 #'smie-blink-matching-open 'append 'local)
1667 (set (make-local-variable 'smie-blink-matching-triggers)
1668 (append smie-blink-matching-triggers
1669 ;; Rather than wait for SPC to blink, try to blink as
1670 ;; soon as we type the last char of a block ender.
1671 (let ((closers (sort (mapcar #'cdr smie-closer-alist)
1672 #'string-lessp))
1673 (triggers ())
1674 closer)
1675 (while (setq closer (pop closers))
1676 (unless (and closers
1677 ;; FIXME: this eliminates prefixes of other
4c36be58
PE
1678 ;; closers, but we should probably
1679 ;; eliminate prefixes of other keywords
1680 ;; as well.
7f925a67
SM
1681 (string-prefix-p closer (car closers)))
1682 (push (aref closer (1- (length closer))) triggers)))
1683 (delete-dups triggers)))))))
1684
1685
1686(provide 'smie)
1687;;; smie.el ends here