| 1 | ;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*- |
| 2 | |
| 3 | ;; Copyright (C) 2010-2014 Free Software Foundation, Inc. |
| 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 |
| 59 | ;; http://dickgrune.com/Books/PTAPG_1st_Edition/). |
| 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 | |
| 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. |
| 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. |
| 82 | |
| 83 | ;; TODO & BUGS: |
| 84 | ;; |
| 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. |
| 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. |
| 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"). |
| 117 | |
| 118 | ;;; Code: |
| 119 | |
| 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 | |
| 124 | (eval-when-compile (require 'cl-lib)) |
| 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. |
| 147 | ;; - a precedence-level table (key word "grammar"), which is an alist |
| 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 | |
| 155 | (defvar smie-warning-count 0) |
| 156 | |
| 157 | (defun smie-set-prec2tab (table x y val &optional override) |
| 158 | (cl-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) |
| 168 | (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)) |
| 169 | (cl-incf smie-warning-count)) |
| 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) |
| 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 >." |
| 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 |
| 239 | ;; the repetition, maybe). |
| 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) |
| 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 | (cl-pushnew (car rhs) first-ops) |
| 272 | (cl-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. |
| 282 | (when (member (cadr rhs) nts) |
| 283 | (error "Adjacent non-terminals: %s %s" |
| 284 | (car rhs) (cadr rhs))) |
| 285 | (cl-pushnew (cadr rhs) first-ops))) |
| 286 | (let ((shr (reverse rhs))) |
| 287 | (if (not (member (car shr) nts)) |
| 288 | (cl-pushnew (car shr) last-ops) |
| 289 | (cl-pushnew (car shr) last-nts) |
| 290 | (when (consp (cdr shr)) |
| 291 | (when (member (cadr shr) nts) |
| 292 | (error "Adjacent non-terminals: %s %s" |
| 293 | (cadr shr) (car shr))) |
| 294 | (cl-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. |
| 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))) |
| 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 | |
| 399 | (defun smie-bnf--closer-alist (bnf &optional no-inners) |
| 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) |
| 419 | (cl-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 | (cl-pushnew (cons (car rhs) term) alist :test #'equal))))))) |
| 425 | (nreverse alist))) |
| 426 | |
| 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) |
| 440 | "Return a table classifying terminals. |
| 441 | Each terminal can either be an `opener', a `closer', or `neither'." |
| 442 | (let ((table (make-hash-table :test #'equal)) |
| 443 | (alist '())) |
| 444 | (dolist (category bnf) |
| 445 | (puthash (car category) t table)) ;Mark non-terminals. |
| 446 | (dolist (category bnf) |
| 447 | (dolist (rhs (cdr category)) |
| 448 | (if (null (cdr rhs)) |
| 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)))) |
| 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))) |
| 486 | (cl-assert res) |
| 487 | res)) |
| 488 | cycle))) |
| 489 | (mapconcat |
| 490 | (lambda (elems) (mapconcat 'identity elems "=")) |
| 491 | (append names (list (car names))) |
| 492 | " < "))) |
| 493 | |
| 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) (cl-assert (eq v '<))) |
| 502 | ;; ((> left right) (cl-assert (eq v '>))) |
| 503 | ;; (t (cl-assert (eq v '=)))))))) |
| 504 | ;; prec2)) |
| 505 | |
| 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 ()) |
| 517 | (eqs ())) |
| 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) |
| 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)))))) |
| 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) |
| 547 | nil ;Nothing to do. |
| 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) |
| 577 | ;; (smie-check-grammar table prec2 'step1) |
| 578 | (cl-incf i)) |
| 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))))) |
| 584 | (cl-incf i 10)) |
| 585 | ;; Propagate equality constraints back to their sources. |
| 586 | (dolist (eq (nreverse eqs)) |
| 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) |
| 595 | (cl-incf i)) |
| 596 | (cl-assert (or (null (caar eq)) (eq (caar eq) (cadr eq)))) |
| 597 | (setcar (car eq) (cadr eq)) |
| 598 | ;; (smie-check-grammar table prec2 'step2) |
| 599 | ) |
| 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) |
| 604 | (setf (nth 1 x) i) |
| 605 | (cl-incf i)) ;See other (cl-incf i) above. |
| 606 | (unless (nth 2 x) |
| 607 | (setf (nth 2 x) i) |
| 608 | (cl-incf i)))) ;See other (cl-incf i) above. |
| 609 | ;; Mark closers and openers. |
| 610 | (dolist (x (gethash :smie-open/close-alist prec2)) |
| 611 | (let* ((token (car x)) |
| 612 | (cons (pcase (cdr x) |
| 613 | (`closer (cddr (assoc token table))) |
| 614 | (`opener (cdr (assoc token table)))))) |
| 615 | (cl-assert (numberp (car cons))) |
| 616 | (setf (car cons) (list (car cons))))) |
| 617 | (let ((ca (gethash :smie-closer-alist prec2))) |
| 618 | (when ca (push (cons :smie-closer-alist ca) table))) |
| 619 | ;; (smie-check-grammar table prec2 'step3) |
| 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. |
| 629 | LEFT-LEVEL and RIGHT-LEVEL can be either numbers or a list, where a list |
| 630 | means that this operator does not bind on the corresponding side, |
| 631 | e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like |
| 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. |
| 687 | HALFSEXP can also be a token, in which case it means to parse as if |
| 688 | we had just successfully passed this token. |
| 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. |
| 694 | Instead of t, the `car' can also be some other non-nil non-number value. |
| 695 | (nil POS TOKEN): we skipped over a paren-like pair. |
| 696 | nil: we skipped over an identifier, matched parentheses, ..." |
| 697 | (catch 'return |
| 698 | (let ((levels |
| 699 | (if (stringp halfsexp) |
| 700 | (prog1 (list (cdr (assoc halfsexp smie-grammar))) |
| 701 | (setq halfsexp nil))))) |
| 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 |
| 710 | (progn (funcall next-sexp 1) nil) |
| 711 | (scan-error |
| 712 | (let* ((epos1 (nth 2 err)) |
| 713 | (epos (if (<= (point) epos1) (nth 3 err) epos1))) |
| 714 | (goto-char pos) |
| 715 | (throw 'return |
| 716 | (list t epos |
| 717 | (buffer-substring-no-properties |
| 718 | epos |
| 719 | (+ epos (if (< (point) epos) -1 1)))))))) |
| 720 | (if (eq pos (point)) |
| 721 | ;; We did not move, so let's abort the loop. |
| 722 | (throw 'return (list t (point)))))) |
| 723 | ((not (numberp (funcall op-back toklevels))) |
| 724 | ;; A token like a paren-close. |
| 725 | (cl-assert (numberp ; Otherwise, why mention it in smie-grammar. |
| 726 | (funcall op-forw toklevels))) |
| 727 | (push toklevels levels)) |
| 728 | (t |
| 729 | (while (and levels (< (funcall op-back toklevels) |
| 730 | (funcall op-forw (car levels)))) |
| 731 | (setq levels (cdr levels))) |
| 732 | (cond |
| 733 | ((null levels) |
| 734 | (if (and halfsexp (numberp (funcall op-forw toklevels))) |
| 735 | (push toklevels levels) |
| 736 | (throw 'return |
| 737 | (prog1 (list (or (funcall op-forw toklevels) t) |
| 738 | (point) token) |
| 739 | (goto-char pos))))) |
| 740 | (t |
| 741 | (let ((lastlevels levels)) |
| 742 | (if (and levels (= (funcall op-back toklevels) |
| 743 | (funcall op-forw (car levels)))) |
| 744 | (setq levels (cdr levels))) |
| 745 | ;; We may have found a match for the previously pending |
| 746 | ;; operator. Is this the end? |
| 747 | (cond |
| 748 | ;; Keep looking as long as we haven't matched the |
| 749 | ;; topmost operator. |
| 750 | (levels |
| 751 | (cond |
| 752 | ((numberp (funcall op-forw toklevels)) |
| 753 | (push toklevels levels)) |
| 754 | ;; FIXME: For some languages, we can express the grammar |
| 755 | ;; OK, but next-sexp doesn't stop where we'd want it to. |
| 756 | ;; E.g. in SML, we'd want to stop right in front of |
| 757 | ;; "local" if we're scanning (both forward and backward) |
| 758 | ;; from a "val/fun/..." at the same level. |
| 759 | ;; Same for Pascal/Modula2's "procedure" w.r.t |
| 760 | ;; "type/var/const". |
| 761 | ;; |
| 762 | ;; ((and (functionp (cadr (funcall op-forw toklevels))) |
| 763 | ;; (funcall (cadr (funcall op-forw toklevels)) |
| 764 | ;; levels)) |
| 765 | ;; (setq levels nil)) |
| 766 | )) |
| 767 | ;; We matched the topmost operator. If the new operator |
| 768 | ;; is the last in the corresponding BNF rule, we're done. |
| 769 | ((not (numberp (funcall op-forw toklevels))) |
| 770 | ;; It is the last element, let's stop here. |
| 771 | (throw 'return (list nil (point) token))) |
| 772 | ;; If the new operator is not the last in the BNF rule, |
| 773 | ;; and is not associative, it's one of the inner operators |
| 774 | ;; (like the "in" in "let .. in .. end"), so keep looking. |
| 775 | ((not (smie--associative-p toklevels)) |
| 776 | (push toklevels levels)) |
| 777 | ;; The new operator is associative. Two cases: |
| 778 | ;; - it's really just an associative operator (like + or ;) |
| 779 | ;; in which case we should have stopped right before. |
| 780 | ((and lastlevels |
| 781 | (smie--associative-p (car lastlevels))) |
| 782 | (throw 'return |
| 783 | (prog1 (list (or (funcall op-forw toklevels) t) |
| 784 | (point) token) |
| 785 | (goto-char pos)))) |
| 786 | ;; - it's an associative operator within a larger construct |
| 787 | ;; (e.g. an "elsif"), so we should just ignore it and keep |
| 788 | ;; looking for the closing element. |
| 789 | (t (setq levels lastlevels)))))))) |
| 790 | levels) |
| 791 | (setq halfsexp nil))))) |
| 792 | |
| 793 | (defun smie-backward-sexp (&optional halfsexp) |
| 794 | "Skip over one sexp. |
| 795 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the |
| 796 | first token we see is an operator, skip over its left-hand-side argument. |
| 797 | HALFSEXP can also be a token, in which case we should skip the text |
| 798 | assuming it is the left-hand-side argument of that token. |
| 799 | Possible return values: |
| 800 | (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level |
| 801 | is too high. LEFT-LEVEL is the left-level of TOKEN, |
| 802 | POS is its start position in the buffer. |
| 803 | (t POS TOKEN): same thing but for an open-paren or the beginning of buffer. |
| 804 | Instead of t, the `car' can also be some other non-nil non-number value. |
| 805 | (nil POS TOKEN): we skipped over a paren-like pair. |
| 806 | nil: we skipped over an identifier, matched parentheses, ..." |
| 807 | (smie-next-sexp |
| 808 | (indirect-function smie-backward-token-function) |
| 809 | (indirect-function 'backward-sexp) |
| 810 | (indirect-function 'smie-op-left) |
| 811 | (indirect-function 'smie-op-right) |
| 812 | halfsexp)) |
| 813 | |
| 814 | (defun smie-forward-sexp (&optional halfsexp) |
| 815 | "Skip over one sexp. |
| 816 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the |
| 817 | first token we see is an operator, skip over its right-hand-side argument. |
| 818 | HALFSEXP can also be a token, in which case we should skip the text |
| 819 | assuming it is the right-hand-side argument of that token. |
| 820 | Possible return values: |
| 821 | (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level |
| 822 | is too high. RIGHT-LEVEL is the right-level of TOKEN, |
| 823 | POS is its end position in the buffer. |
| 824 | (t POS TOKEN): same thing but for a close-paren or the end of buffer. |
| 825 | Instead of t, the `car' can also be some other non-nil non-number value. |
| 826 | (nil POS TOKEN): we skipped over a paren-like pair. |
| 827 | nil: we skipped over an identifier, matched parentheses, ..." |
| 828 | (smie-next-sexp |
| 829 | (indirect-function smie-forward-token-function) |
| 830 | (indirect-function 'forward-sexp) |
| 831 | (indirect-function 'smie-op-right) |
| 832 | (indirect-function 'smie-op-left) |
| 833 | halfsexp)) |
| 834 | |
| 835 | ;;; Miscellaneous commands using the precedence parser. |
| 836 | |
| 837 | (defun smie-backward-sexp-command (&optional n) |
| 838 | "Move backward through N logical elements." |
| 839 | (interactive "^p") |
| 840 | (smie-forward-sexp-command (- n))) |
| 841 | |
| 842 | (defun smie-forward-sexp-command (&optional n) |
| 843 | "Move forward through N logical elements." |
| 844 | (interactive "^p") |
| 845 | (let ((forw (> n 0)) |
| 846 | (forward-sexp-function nil)) |
| 847 | (while (/= n 0) |
| 848 | (setq n (- n (if forw 1 -1))) |
| 849 | (let ((pos (point)) |
| 850 | (res (if forw |
| 851 | (smie-forward-sexp 'halfsexp) |
| 852 | (smie-backward-sexp 'halfsexp)))) |
| 853 | (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp)))) |
| 854 | (signal 'scan-error |
| 855 | (list "Containing expression ends prematurely" |
| 856 | (cadr res) (cadr res))) |
| 857 | nil))))) |
| 858 | |
| 859 | (defvar smie-closer-alist nil |
| 860 | "Alist giving the closer corresponding to an opener.") |
| 861 | |
| 862 | (defun smie-close-block () |
| 863 | "Close the closest surrounding block." |
| 864 | (interactive) |
| 865 | (let ((closer |
| 866 | (save-excursion |
| 867 | (backward-up-list 1) |
| 868 | (if (looking-at "\\s(") |
| 869 | (string (cdr (syntax-after (point)))) |
| 870 | (let* ((open (funcall smie-forward-token-function)) |
| 871 | (closer (cdr (assoc open smie-closer-alist))) |
| 872 | (levels (list (assoc open smie-grammar))) |
| 873 | (seen '()) |
| 874 | (found '())) |
| 875 | (cond |
| 876 | ;; Even if we improve the auto-computation of closers, |
| 877 | ;; there are still cases where we need manual |
| 878 | ;; intervention, e.g. for Octave's use of `until' |
| 879 | ;; as a pseudo-closer of `do'. |
| 880 | (closer) |
| 881 | ((or (equal levels '(nil)) (numberp (nth 1 (car levels)))) |
| 882 | (error "Doesn't look like a block")) |
| 883 | (t |
| 884 | ;; Now that smie-setup automatically sets smie-closer-alist |
| 885 | ;; from the BNF, this is not really needed any more. |
| 886 | (while levels |
| 887 | (let ((level (pop levels))) |
| 888 | (dolist (other smie-grammar) |
| 889 | (when (and (eq (nth 2 level) (nth 1 other)) |
| 890 | (not (memq other seen))) |
| 891 | (push other seen) |
| 892 | (if (numberp (nth 2 other)) |
| 893 | (push other levels) |
| 894 | (push (car other) found)))))) |
| 895 | (cond |
| 896 | ((null found) (error "No known closer for opener %s" open)) |
| 897 | ;; What should we do if there are various closers? |
| 898 | (t (car found)))))))))) |
| 899 | (unless (save-excursion (skip-chars-backward " \t") (bolp)) |
| 900 | (newline)) |
| 901 | (insert closer) |
| 902 | (if (save-excursion (skip-chars-forward " \t") (eolp)) |
| 903 | (indent-according-to-mode) |
| 904 | (reindent-then-newline-and-indent)))) |
| 905 | |
| 906 | (defun smie-down-list (&optional arg) |
| 907 | "Move forward down one level paren-like blocks. Like `down-list'. |
| 908 | With argument ARG, do this that many times. |
| 909 | A negative argument means move backward but still go down a level. |
| 910 | This command assumes point is not in a string or comment." |
| 911 | (interactive "p") |
| 912 | (let ((start (point)) |
| 913 | (inc (if (< arg 0) -1 1)) |
| 914 | (offset (if (< arg 0) 1 0)) |
| 915 | (next-token (if (< arg 0) |
| 916 | smie-backward-token-function |
| 917 | smie-forward-token-function))) |
| 918 | (while (/= arg 0) |
| 919 | (setq arg (- arg inc)) |
| 920 | (while |
| 921 | (let* ((pos (point)) |
| 922 | (token (funcall next-token)) |
| 923 | (levels (assoc token smie-grammar))) |
| 924 | (cond |
| 925 | ((zerop (length token)) |
| 926 | (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point))) |
| 927 | (looking-at "\\s(\\|\\s)")) |
| 928 | ;; Go back to `start' in case of an error. This presumes |
| 929 | ;; none of the token we've found until now include a ( or ). |
| 930 | (progn (goto-char start) (down-list inc) nil) |
| 931 | (forward-sexp inc) |
| 932 | (/= (point) pos))) |
| 933 | ((and levels (not (numberp (nth (+ 1 offset) levels)))) nil) |
| 934 | ((and levels (not (numberp (nth (- 2 offset) levels)))) |
| 935 | (let ((end (point))) |
| 936 | (goto-char start) |
| 937 | (signal 'scan-error |
| 938 | (list "Containing expression ends prematurely" |
| 939 | pos end)))) |
| 940 | (t))))))) |
| 941 | |
| 942 | (defvar smie-blink-matching-triggers '(?\s ?\n) |
| 943 | "Chars which might trigger `blink-matching-open'. |
| 944 | These can include the final chars of end-tokens, or chars that are |
| 945 | typically inserted right after an end token. |
| 946 | I.e. a good choice can be: |
| 947 | (delete-dups |
| 948 | (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw))))) |
| 949 | smie-closer-alist))") |
| 950 | |
| 951 | (defcustom smie-blink-matching-inners t |
| 952 | "Whether SMIE should blink to matching opener for inner keywords. |
| 953 | If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." |
| 954 | :type 'boolean |
| 955 | :group 'smie) |
| 956 | |
| 957 | (defun smie-blink-matching-check (start end) |
| 958 | (save-excursion |
| 959 | (goto-char end) |
| 960 | (let ((ender (funcall smie-backward-token-function))) |
| 961 | (cond |
| 962 | ((not (and ender (rassoc ender smie-closer-alist))) |
| 963 | ;; This is not one of the begin..end we know how to check. |
| 964 | (blink-matching-check-mismatch start end)) |
| 965 | ((not start) t) |
| 966 | ((eq t (car (rassoc ender smie-closer-alist))) nil) |
| 967 | (t |
| 968 | (goto-char start) |
| 969 | (let ((starter (funcall smie-forward-token-function))) |
| 970 | (not (member (cons starter ender) smie-closer-alist)))))))) |
| 971 | |
| 972 | (defun smie-blink-matching-open () |
| 973 | "Blink the matching opener when applicable. |
| 974 | This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." |
| 975 | (let ((pos (point)) ;Position after the close token. |
| 976 | token) |
| 977 | (when (and blink-matching-paren |
| 978 | smie-closer-alist ; Optimization. |
| 979 | (or (eq (char-before) last-command-event) ;; Sanity check. |
| 980 | (save-excursion |
| 981 | (or (progn (skip-chars-backward " \t") |
| 982 | (setq pos (point)) |
| 983 | (eq (char-before) last-command-event)) |
| 984 | (progn (skip-chars-backward " \n\t") |
| 985 | (setq pos (point)) |
| 986 | (eq (char-before) last-command-event))))) |
| 987 | (memq last-command-event smie-blink-matching-triggers) |
| 988 | (not (nth 8 (syntax-ppss)))) |
| 989 | (save-excursion |
| 990 | (setq token (funcall smie-backward-token-function)) |
| 991 | (when (and (eq (point) (1- pos)) |
| 992 | (= 1 (length token)) |
| 993 | (not (rassoc token smie-closer-alist))) |
| 994 | ;; The trigger char is itself a token but is not one of the |
| 995 | ;; closers (e.g. ?\; in Octave mode), so go back to the |
| 996 | ;; previous token. |
| 997 | (setq pos (point)) |
| 998 | (setq token (funcall smie-backward-token-function))) |
| 999 | (when (rassoc token smie-closer-alist) |
| 1000 | ;; We're after a close token. Let's still make sure we |
| 1001 | ;; didn't skip a comment to find that token. |
| 1002 | (funcall smie-forward-token-function) |
| 1003 | (when (and (save-excursion |
| 1004 | ;; Skip the trigger char, if applicable. |
| 1005 | (if (eq (char-after) last-command-event) |
| 1006 | (forward-char 1)) |
| 1007 | (if (eq ?\n last-command-event) |
| 1008 | ;; Skip any auto-indentation, if applicable. |
| 1009 | (skip-chars-forward " \t")) |
| 1010 | (>= (point) pos)) |
| 1011 | ;; If token ends with a trigger char, don't blink for |
| 1012 | ;; anything else than this trigger char, lest we'd blink |
| 1013 | ;; both when inserting the trigger char and when |
| 1014 | ;; inserting a subsequent trigger char like SPC. |
| 1015 | (or (eq (char-before) last-command-event) |
| 1016 | (not (memq (char-before) |
| 1017 | smie-blink-matching-triggers))) |
| 1018 | ;; FIXME: For octave's "switch ... case ... case" we flash |
| 1019 | ;; `switch' at the end of the first `case' and we burp |
| 1020 | ;; "mismatch" at the end of the second `case'. |
| 1021 | (or smie-blink-matching-inners |
| 1022 | (not (numberp (nth 2 (assoc token smie-grammar)))))) |
| 1023 | ;; The major mode might set blink-matching-check-function |
| 1024 | ;; buffer-locally so that interactive calls to |
| 1025 | ;; blink-matching-open work right, but let's not presume |
| 1026 | ;; that's the case. |
| 1027 | (let ((blink-matching-check-function #'smie-blink-matching-check)) |
| 1028 | (blink-matching-open)))))))) |
| 1029 | |
| 1030 | (defvar-local smie--matching-block-data-cache nil) |
| 1031 | |
| 1032 | (defun smie--opener/closer-at-point () |
| 1033 | "Return (OPENER TOKEN START END) or nil. |
| 1034 | OPENER is non-nil if TOKEN is an opener and nil if it's a closer." |
| 1035 | (let* ((start (point)) |
| 1036 | ;; Move to a previous position outside of a token. |
| 1037 | (_ (funcall smie-backward-token-function)) |
| 1038 | ;; Move to the end of the token before point. |
| 1039 | (btok (funcall smie-forward-token-function)) |
| 1040 | (bend (point))) |
| 1041 | (cond |
| 1042 | ;; Token before point is a closer? |
| 1043 | ((and (>= bend start) (rassoc btok smie-closer-alist)) |
| 1044 | (funcall smie-backward-token-function) |
| 1045 | (when (< (point) start) |
| 1046 | (prog1 (list nil btok (point) bend) |
| 1047 | (goto-char bend)))) |
| 1048 | ;; Token around point is an opener? |
| 1049 | ((and (> bend start) (assoc btok smie-closer-alist)) |
| 1050 | (funcall smie-backward-token-function) |
| 1051 | (when (<= (point) start) (list t btok (point) bend))) |
| 1052 | ((<= bend start) |
| 1053 | (let ((atok (funcall smie-forward-token-function)) |
| 1054 | (aend (point))) |
| 1055 | (cond |
| 1056 | ((< aend start) nil) ;Hopefully shouldn't happen. |
| 1057 | ;; Token after point is a closer? |
| 1058 | ((assoc atok smie-closer-alist) |
| 1059 | (funcall smie-backward-token-function) |
| 1060 | (when (<= (point) start) |
| 1061 | (list t atok (point) aend))))))))) |
| 1062 | |
| 1063 | (defun smie--matching-block-data (orig &rest args) |
| 1064 | "A function suitable for `show-paren-data-function' (which see)." |
| 1065 | (if (or (null smie-closer-alist) |
| 1066 | (equal (cons (point) (buffer-chars-modified-tick)) |
| 1067 | (car smie--matching-block-data-cache))) |
| 1068 | (or (cdr smie--matching-block-data-cache) |
| 1069 | (apply orig args)) |
| 1070 | (setq smie--matching-block-data-cache |
| 1071 | (list (cons (point) (buffer-chars-modified-tick)))) |
| 1072 | (unless (nth 8 (syntax-ppss)) |
| 1073 | (condition-case nil |
| 1074 | (let ((here (smie--opener/closer-at-point))) |
| 1075 | (when (and here |
| 1076 | (or smie-blink-matching-inners |
| 1077 | (not (numberp |
| 1078 | (nth (if (nth 0 here) 1 2) |
| 1079 | (assoc (nth 1 here) smie-grammar)))))) |
| 1080 | (let ((there |
| 1081 | (cond |
| 1082 | ((car here) ; Opener. |
| 1083 | (let ((data (smie-forward-sexp 'halfsexp)) |
| 1084 | (tend (point))) |
| 1085 | (unless (car data) |
| 1086 | (funcall smie-backward-token-function) |
| 1087 | (list (member (cons (nth 1 here) (nth 2 data)) |
| 1088 | smie-closer-alist) |
| 1089 | (point) tend)))) |
| 1090 | (t ;Closer. |
| 1091 | (let ((data (smie-backward-sexp 'halfsexp)) |
| 1092 | (htok (nth 1 here))) |
| 1093 | (if (car data) |
| 1094 | (let* ((hprec (nth 2 (assoc htok smie-grammar))) |
| 1095 | (ttok (nth 2 data)) |
| 1096 | (tprec (nth 1 (assoc ttok smie-grammar)))) |
| 1097 | (when (and (numberp hprec) ;Here is an inner. |
| 1098 | (eq hprec tprec)) |
| 1099 | (goto-char (nth 1 data)) |
| 1100 | (let ((tbeg (point))) |
| 1101 | (funcall smie-forward-token-function) |
| 1102 | (list t tbeg (point))))) |
| 1103 | (let ((tbeg (point))) |
| 1104 | (funcall smie-forward-token-function) |
| 1105 | (list (member (cons (nth 2 data) htok) |
| 1106 | smie-closer-alist) |
| 1107 | tbeg (point))))))))) |
| 1108 | ;; Update the cache. |
| 1109 | (setcdr smie--matching-block-data-cache |
| 1110 | (list (nth 2 here) (nth 3 here) |
| 1111 | (nth 1 there) (nth 2 there) |
| 1112 | (not (nth 0 there))))))) |
| 1113 | (scan-error nil)) |
| 1114 | (goto-char (caar smie--matching-block-data-cache))) |
| 1115 | (apply #'smie--matching-block-data orig args))) |
| 1116 | |
| 1117 | ;;; The indentation engine. |
| 1118 | |
| 1119 | (defcustom smie-indent-basic 4 |
| 1120 | "Basic amount of indentation." |
| 1121 | :type 'integer |
| 1122 | :group 'smie) |
| 1123 | |
| 1124 | (defvar smie-rules-function 'ignore |
| 1125 | "Function providing the indentation rules. |
| 1126 | It takes two arguments METHOD and ARG where the meaning of ARG |
| 1127 | and the expected return value depends on METHOD. |
| 1128 | METHOD can be: |
| 1129 | - :after, in which case ARG is a token and the function should return the |
| 1130 | OFFSET to use for indentation after ARG. |
| 1131 | - :before, in which case ARG is a token and the function should return the |
| 1132 | OFFSET to use to indent ARG itself. |
| 1133 | - :elem, in which case the function should return either: |
| 1134 | - the offset to use to indent function arguments (ARG = `arg') |
| 1135 | - the basic indentation step (ARG = `basic'). |
| 1136 | - :list-intro, in which case ARG is a token and the function should return |
| 1137 | non-nil if TOKEN is followed by a list of expressions (not separated by any |
| 1138 | token) rather than an expression. |
| 1139 | - :close-all, in which case ARG is a close-paren token at indentation and |
| 1140 | the function should return non-nil if it should be aligned with the opener |
| 1141 | of the last close-paren token on the same line, if there are multiple. |
| 1142 | Otherwise, it will be aligned with its own opener. |
| 1143 | |
| 1144 | When ARG is a token, the function is called with point just before that token. |
| 1145 | A return value of nil always means to fallback on the default behavior, so the |
| 1146 | function should return nil for arguments it does not expect. |
| 1147 | |
| 1148 | OFFSET can be: |
| 1149 | nil use the default indentation rule. |
| 1150 | \(column . COLUMN) indent to column COLUMN. |
| 1151 | NUMBER offset by NUMBER, relative to a base token |
| 1152 | which is the current token for :after and |
| 1153 | its parent for :before. |
| 1154 | |
| 1155 | The functions whose name starts with \"smie-rule-\" are helper functions |
| 1156 | designed specifically for use in this function.") |
| 1157 | |
| 1158 | (defvar smie--hanging-eolp-function |
| 1159 | ;; FIXME: This is a quick hack for 24.4. Don't document it and replace with |
| 1160 | ;; a well-defined function with a cleaner interface instead! |
| 1161 | (lambda () |
| 1162 | (skip-chars-forward " \t") |
| 1163 | (or (eolp) |
| 1164 | (and ;; (looking-at comment-start-skip) ;(bug#16041). |
| 1165 | (forward-comment (point-max)))))) |
| 1166 | |
| 1167 | (defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) |
| 1168 | (defun smie-indent--hanging-p () |
| 1169 | "Return non-nil if the current token is \"hanging\". |
| 1170 | A hanging keyword is one that's at the end of a line except it's not at |
| 1171 | the beginning of a line." |
| 1172 | (and (not (smie-indent--bolp)) |
| 1173 | (save-excursion |
| 1174 | (<= (line-end-position) |
| 1175 | (progn |
| 1176 | (and (zerop (length (funcall smie-forward-token-function))) |
| 1177 | (not (eobp)) |
| 1178 | ;; Could be an open-paren. |
| 1179 | (forward-char 1)) |
| 1180 | (funcall smie--hanging-eolp-function) |
| 1181 | (point)))))) |
| 1182 | |
| 1183 | (defalias 'smie-rule-bolp 'smie-indent--bolp) |
| 1184 | (defun smie-indent--bolp () |
| 1185 | "Return non-nil if the current token is the first on the line." |
| 1186 | (save-excursion (skip-chars-backward " \t") (bolp))) |
| 1187 | |
| 1188 | (defun smie-indent--bolp-1 () |
| 1189 | ;; Like smie-indent--bolp but also returns non-nil if it's the first |
| 1190 | ;; non-comment token. Maybe we should simply always use this? |
| 1191 | "Return non-nil if the current token is the first on the line. |
| 1192 | Comments are treated as spaces." |
| 1193 | (let ((bol (line-beginning-position))) |
| 1194 | (save-excursion |
| 1195 | (forward-comment (- (point))) |
| 1196 | (<= (point) bol)))) |
| 1197 | |
| 1198 | ;; Dynamically scoped. |
| 1199 | (defvar smie--parent) (defvar smie--after) (defvar smie--token) |
| 1200 | |
| 1201 | (defun smie-indent--parent () |
| 1202 | (or smie--parent |
| 1203 | (save-excursion |
| 1204 | (let* ((pos (point)) |
| 1205 | (tok (funcall smie-forward-token-function))) |
| 1206 | (unless (numberp (cadr (assoc tok smie-grammar))) |
| 1207 | (goto-char pos)) |
| 1208 | (setq smie--parent |
| 1209 | (or (smie-backward-sexp 'halfsexp) |
| 1210 | (let (res) |
| 1211 | (while (null (setq res (smie-backward-sexp)))) |
| 1212 | (list nil (point) (nth 2 res))))))))) |
| 1213 | |
| 1214 | (defun smie-rule-parent-p (&rest parents) |
| 1215 | "Return non-nil if the current token's parent is among PARENTS. |
| 1216 | Only meaningful when called from within `smie-rules-function'." |
| 1217 | (member (nth 2 (smie-indent--parent)) parents)) |
| 1218 | |
| 1219 | (defun smie-rule-next-p (&rest tokens) |
| 1220 | "Return non-nil if the next token is among TOKENS. |
| 1221 | Only meaningful when called from within `smie-rules-function'." |
| 1222 | (let ((next |
| 1223 | (save-excursion |
| 1224 | (unless smie--after |
| 1225 | (smie-indent-forward-token) (setq smie--after (point))) |
| 1226 | (goto-char smie--after) |
| 1227 | (smie-indent-forward-token)))) |
| 1228 | (member (car next) tokens))) |
| 1229 | |
| 1230 | (defun smie-rule-prev-p (&rest tokens) |
| 1231 | "Return non-nil if the previous token is among TOKENS." |
| 1232 | (let ((prev (save-excursion |
| 1233 | (smie-indent-backward-token)))) |
| 1234 | (member (car prev) tokens))) |
| 1235 | |
| 1236 | (defun smie-rule-sibling-p () |
| 1237 | "Return non-nil if the parent is actually a sibling. |
| 1238 | Only meaningful when called from within `smie-rules-function'." |
| 1239 | (eq (car (smie-indent--parent)) |
| 1240 | (cadr (assoc smie--token smie-grammar)))) |
| 1241 | |
| 1242 | (defun smie-rule-parent (&optional offset) |
| 1243 | "Align with parent. |
| 1244 | If non-nil, OFFSET should be an integer giving an additional offset to apply. |
| 1245 | Only meaningful when called from within `smie-rules-function'." |
| 1246 | (save-excursion |
| 1247 | (goto-char (cadr (smie-indent--parent))) |
| 1248 | (cons 'column |
| 1249 | (+ (or offset 0) |
| 1250 | (smie-indent-virtual))))) |
| 1251 | |
| 1252 | (defvar smie-rule-separator-outdent 2) |
| 1253 | |
| 1254 | (defun smie-indent--separator-outdent () |
| 1255 | ;; FIXME: Here we actually have several reasonable behaviors. |
| 1256 | ;; E.g. for a parent token of "FOO" and a separator ";" we may want to: |
| 1257 | ;; 1- left-align ; with FOO. |
| 1258 | ;; 2- right-align ; with FOO. |
| 1259 | ;; 3- align content after ; with content after FOO. |
| 1260 | ;; 4- align content plus add/remove spaces so as to align ; with FOO. |
| 1261 | ;; Currently, we try to align the contents (option 3) which actually behaves |
| 1262 | ;; just like option 2 (if the number of spaces after FOO and ; is equal). |
| 1263 | (let ((afterpos (save-excursion |
| 1264 | (let ((tok (funcall smie-forward-token-function))) |
| 1265 | (unless tok |
| 1266 | (with-demoted-errors |
| 1267 | (error "smie-rule-separator: can't skip token %s" |
| 1268 | smie--token)))) |
| 1269 | (skip-chars-forward " ") |
| 1270 | (unless (eolp) (point))))) |
| 1271 | (or (and afterpos |
| 1272 | ;; This should always be true, unless |
| 1273 | ;; smie-forward-token-function skipped a \n. |
| 1274 | (< afterpos (line-end-position)) |
| 1275 | (- afterpos (point))) |
| 1276 | smie-rule-separator-outdent))) |
| 1277 | |
| 1278 | (defun smie-rule-separator (method) |
| 1279 | "Indent current token as a \"separator\". |
| 1280 | By \"separator\", we mean here a token whose sole purpose is to separate |
| 1281 | various elements within some enclosing syntactic construct, and which does |
| 1282 | not have any semantic significance in itself (i.e. it would typically no exist |
| 1283 | as a node in an abstract syntax tree). |
| 1284 | Such a token is expected to have an associative syntax and be closely tied |
| 1285 | to its syntactic parent. Typical examples are \",\" in lists of arguments |
| 1286 | \(enclosed inside parentheses), or \";\" in sequences of instructions (enclosed |
| 1287 | in a {..} or begin..end block). |
| 1288 | METHOD should be the method name that was passed to `smie-rules-function'. |
| 1289 | Only meaningful when called from within `smie-rules-function'." |
| 1290 | ;; FIXME: The code below works OK for cases where the separators |
| 1291 | ;; are placed consistently always at beginning or always at the end, |
| 1292 | ;; but not if some are at the beginning and others are at the end. |
| 1293 | ;; I.e. it gets confused in cases such as: |
| 1294 | ;; ( a |
| 1295 | ;; , a, |
| 1296 | ;; b |
| 1297 | ;; , c, |
| 1298 | ;; d |
| 1299 | ;; ) |
| 1300 | ;; |
| 1301 | ;; Assuming token is associative, the default rule for associative |
| 1302 | ;; tokens (which assumes an infix operator) works fine for many cases. |
| 1303 | ;; We mostly need to take care of the case where token is at beginning of |
| 1304 | ;; line, in which case we want to align it with its enclosing parent. |
| 1305 | (cond |
| 1306 | ((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p))) |
| 1307 | (let ((parent-col (cdr (smie-rule-parent))) |
| 1308 | (parent-pos-col ;FIXME: we knew this when computing smie--parent. |
| 1309 | (save-excursion |
| 1310 | (goto-char (cadr smie--parent)) |
| 1311 | (smie-indent-forward-token) |
| 1312 | (forward-comment (point-max)) |
| 1313 | (current-column)))) |
| 1314 | (cons 'column |
| 1315 | (max parent-col |
| 1316 | (min parent-pos-col |
| 1317 | (- parent-pos-col (smie-indent--separator-outdent))))))) |
| 1318 | ((and (eq method :after) (smie-indent--bolp)) |
| 1319 | (smie-indent--separator-outdent)))) |
| 1320 | |
| 1321 | (defun smie-indent--offset (elem) |
| 1322 | (or (funcall smie-rules-function :elem elem) |
| 1323 | (if (not (eq elem 'basic)) |
| 1324 | (funcall smie-rules-function :elem 'basic)) |
| 1325 | smie-indent-basic)) |
| 1326 | |
| 1327 | (defun smie-indent--rule (method token |
| 1328 | ;; FIXME: Too many parameters. |
| 1329 | &optional after parent base-pos) |
| 1330 | "Compute indentation column according to `smie-rules-function'. |
| 1331 | METHOD and TOKEN are passed to `smie-rules-function'. |
| 1332 | AFTER is the position after TOKEN, if known. |
| 1333 | PARENT is the parent info returned by `smie-backward-sexp', if known. |
| 1334 | BASE-POS is the position relative to which offsets should be applied." |
| 1335 | ;; This is currently called in 3 cases: |
| 1336 | ;; - :before opener, where rest=nil but base-pos could as well be parent. |
| 1337 | ;; - :before other, where |
| 1338 | ;; ; after=nil |
| 1339 | ;; ; parent is set |
| 1340 | ;; ; base-pos=parent |
| 1341 | ;; - :after tok, where |
| 1342 | ;; ; after is set; parent=nil; base-pos=point; |
| 1343 | (save-excursion |
| 1344 | (let ((offset (smie-indent--rule-1 method token after parent))) |
| 1345 | (cond |
| 1346 | ((not offset) nil) |
| 1347 | ((eq (car-safe offset) 'column) (cdr offset)) |
| 1348 | ((integerp offset) |
| 1349 | (+ offset |
| 1350 | (if (null base-pos) 0 |
| 1351 | (goto-char base-pos) |
| 1352 | ;; Use smie-indent-virtual when indenting relative to an opener: |
| 1353 | ;; this will also by default use current-column unless |
| 1354 | ;; that opener is hanging, but will additionally consult |
| 1355 | ;; rules-function, so it gives it a chance to tweak indentation |
| 1356 | ;; (e.g. by forcing indentation relative to its own parent, as in |
| 1357 | ;; fn a => fn b => fn c =>). |
| 1358 | ;; When parent==nil it doesn't matter because the only case |
| 1359 | ;; where it's really used is when the base-pos is hanging anyway. |
| 1360 | (if (or (and parent (null (car parent))) |
| 1361 | (smie-indent--hanging-p)) |
| 1362 | (smie-indent-virtual) (current-column))))) |
| 1363 | (t (error "Unknown indentation offset %s" offset)))))) |
| 1364 | |
| 1365 | (defun smie-indent--rule-1 (method token &optional after parent) |
| 1366 | (let ((smie--parent parent) |
| 1367 | (smie--token token) |
| 1368 | (smie--after after)) |
| 1369 | (funcall smie-rules-function method token))) |
| 1370 | |
| 1371 | (defun smie-indent-forward-token () |
| 1372 | "Skip token forward and return it, along with its levels." |
| 1373 | (let ((tok (funcall smie-forward-token-function))) |
| 1374 | (cond |
| 1375 | ((< 0 (length tok)) (assoc tok smie-grammar)) |
| 1376 | ((looking-at "\\s(\\|\\s)\\(\\)") |
| 1377 | (forward-char 1) |
| 1378 | (cons (buffer-substring-no-properties (1- (point)) (point)) |
| 1379 | (if (match-end 1) '(0 nil) '(nil 0)))) |
| 1380 | ((looking-at "\\s\"\\|\\s|") |
| 1381 | (forward-sexp 1) |
| 1382 | nil) |
| 1383 | ((eobp) nil) |
| 1384 | (t (error "Bumped into unknown token"))))) |
| 1385 | |
| 1386 | (defun smie-indent-backward-token () |
| 1387 | "Skip token backward and return it, along with its levels." |
| 1388 | (let ((tok (funcall smie-backward-token-function)) |
| 1389 | class) |
| 1390 | (cond |
| 1391 | ((< 0 (length tok)) (assoc tok smie-grammar)) |
| 1392 | ;; 4 == open paren syntax, 5 == close. |
| 1393 | ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5)) |
| 1394 | (forward-char -1) |
| 1395 | (cons (buffer-substring-no-properties (point) (1+ (point))) |
| 1396 | (if (eq class 4) '(nil 0) '(0 nil)))) |
| 1397 | ((memq class '(7 15)) |
| 1398 | (backward-sexp 1) |
| 1399 | nil) |
| 1400 | ((bobp) nil) |
| 1401 | (t (error "Bumped into unknown token"))))) |
| 1402 | |
| 1403 | (defun smie-indent-virtual () |
| 1404 | ;; We used to take an optional arg (with value :not-hanging) to specify that |
| 1405 | ;; we should only use (smie-indent-calculate) if we're looking at a hanging |
| 1406 | ;; keyword. This was a bad idea, because the virtual indent of a position |
| 1407 | ;; should not depend on the caller, since it leads to situations where two |
| 1408 | ;; dependent indentations get indented differently. |
| 1409 | "Compute the virtual indentation to use for point. |
| 1410 | This is used when we're not trying to indent point but just |
| 1411 | need to compute the column at which point should be indented |
| 1412 | in order to figure out the indentation of some other (further down) point." |
| 1413 | ;; Trust pre-existing indentation on other lines. |
| 1414 | (if (smie-indent--bolp) (current-column) (smie-indent-calculate))) |
| 1415 | |
| 1416 | (defun smie-indent-fixindent () |
| 1417 | ;; Obey the `fixindent' special comment. |
| 1418 | (and (smie-indent--bolp) |
| 1419 | (save-excursion |
| 1420 | (comment-normalize-vars) |
| 1421 | (re-search-forward (concat comment-start-skip |
| 1422 | "fixindent" |
| 1423 | comment-end-skip) |
| 1424 | ;; 1+ to account for the \n comment termination. |
| 1425 | (1+ (line-end-position)) t)) |
| 1426 | (current-column))) |
| 1427 | |
| 1428 | (defun smie-indent-bob () |
| 1429 | ;; Start the file at column 0. |
| 1430 | (save-excursion |
| 1431 | (forward-comment (- (point))) |
| 1432 | (if (bobp) 0))) |
| 1433 | |
| 1434 | (defun smie-indent-close () |
| 1435 | ;; Align close paren with opening paren. |
| 1436 | (save-excursion |
| 1437 | ;; (forward-comment (point-max)) |
| 1438 | (when (looking-at "\\s)") |
| 1439 | (if (smie-indent--rule-1 :close-all |
| 1440 | (buffer-substring-no-properties |
| 1441 | (point) (1+ (point))) |
| 1442 | (1+ (point))) |
| 1443 | (while (not (zerop (skip-syntax-forward ")"))) |
| 1444 | (skip-chars-forward " \t")) |
| 1445 | (forward-char 1)) |
| 1446 | (condition-case nil |
| 1447 | (progn |
| 1448 | (backward-sexp 1) |
| 1449 | (smie-indent-virtual)) ;:not-hanging |
| 1450 | (scan-error nil))))) |
| 1451 | |
| 1452 | (defun smie-indent-keyword (&optional token) |
| 1453 | "Indent point based on the token that follows it immediately. |
| 1454 | If TOKEN is non-nil, assume that that is the token that follows point. |
| 1455 | Returns either a column number or nil if it considers that indentation |
| 1456 | should not be computed on the basis of the following token." |
| 1457 | (save-excursion |
| 1458 | (let* ((pos (point)) |
| 1459 | (toklevels |
| 1460 | (if token |
| 1461 | (assoc token smie-grammar) |
| 1462 | (let* ((res (smie-indent-forward-token))) |
| 1463 | ;; Ignore tokens on subsequent lines. |
| 1464 | (if (and (< pos (line-beginning-position)) |
| 1465 | ;; Make sure `token' also *starts* on another line. |
| 1466 | (save-excursion |
| 1467 | (let ((endpos (point))) |
| 1468 | (goto-char pos) |
| 1469 | (forward-line 1) |
| 1470 | (and (equal res (smie-indent-forward-token)) |
| 1471 | (eq (point) endpos))))) |
| 1472 | nil |
| 1473 | (goto-char pos) |
| 1474 | res))))) |
| 1475 | (setq token (pop toklevels)) |
| 1476 | (cond |
| 1477 | ((null (cdr toklevels)) nil) ;Not a keyword. |
| 1478 | ((not (numberp (car toklevels))) |
| 1479 | ;; Different cases: |
| 1480 | ;; - smie-indent--bolp: "indent according to others". |
| 1481 | ;; - common hanging: "indent according to others". |
| 1482 | ;; - SML-let hanging: "indent like parent". |
| 1483 | ;; - if-after-else: "indent-like parent". |
| 1484 | ;; - middle-of-line: "trust current position". |
| 1485 | (cond |
| 1486 | ((smie-indent--rule :before token)) |
| 1487 | ((smie-indent--bolp-1) ;I.e. non-virtual indent. |
| 1488 | ;; For an open-paren-like thingy at BOL, always indent only |
| 1489 | ;; based on other rules (typically smie-indent-after-keyword). |
| 1490 | ;; FIXME: we do the same if after a comment, since we may be trying |
| 1491 | ;; to compute the indentation of this comment and we shouldn't indent |
| 1492 | ;; based on the indentation of subsequent code. |
| 1493 | nil) |
| 1494 | (t |
| 1495 | ;; By default use point unless we're hanging. |
| 1496 | (unless (smie-indent--hanging-p) (current-column))))) |
| 1497 | (t |
| 1498 | ;; FIXME: This still looks too much like black magic!! |
| 1499 | (let* ((parent (smie-backward-sexp token))) |
| 1500 | ;; Different behaviors: |
| 1501 | ;; - align with parent. |
| 1502 | ;; - parent + offset. |
| 1503 | ;; - after parent's column + offset (actually, after or before |
| 1504 | ;; depending on where backward-sexp stopped). |
| 1505 | ;; ? let it drop to some other indentation function (almost never). |
| 1506 | ;; ? parent + offset + parent's own offset. |
| 1507 | ;; Different cases: |
| 1508 | ;; - bump into a same-level operator. |
| 1509 | ;; - bump into a specific known parent. |
| 1510 | ;; - find a matching open-paren thingy. |
| 1511 | ;; - bump into some random parent. |
| 1512 | ;; ? borderline case (almost never). |
| 1513 | ;; ? bump immediately into a parent. |
| 1514 | (cond |
| 1515 | ((not (or (< (point) pos) |
| 1516 | (and (cadr parent) (< (cadr parent) pos)))) |
| 1517 | ;; If we didn't move at all, that means we didn't really skip |
| 1518 | ;; what we wanted. Should almost never happen, other than |
| 1519 | ;; maybe when an infix or close-paren is at the beginning |
| 1520 | ;; of a buffer. |
| 1521 | nil) |
| 1522 | ((save-excursion |
| 1523 | (goto-char pos) |
| 1524 | (smie-indent--rule :before token nil parent (cadr parent)))) |
| 1525 | ((eq (car parent) (car toklevels)) |
| 1526 | ;; We bumped into a same-level operator; align with it. |
| 1527 | (if (and (smie-indent--bolp) (/= (point) pos) |
| 1528 | (save-excursion |
| 1529 | (goto-char (goto-char (cadr parent))) |
| 1530 | (not (smie-indent--bolp)))) |
| 1531 | ;; If the parent is at EOL and its children are indented like |
| 1532 | ;; itself, then we can just obey the indentation chosen for the |
| 1533 | ;; child. |
| 1534 | ;; This is important for operators like ";" which |
| 1535 | ;; are usually at EOL (and have an offset of 0): otherwise we'd |
| 1536 | ;; always go back over all the statements, which is |
| 1537 | ;; a performance problem and would also mean that fixindents |
| 1538 | ;; in the middle of such a sequence would be ignored. |
| 1539 | ;; |
| 1540 | ;; This is a delicate point! |
| 1541 | ;; Even if the offset is not 0, we could follow the same logic |
| 1542 | ;; and subtract the offset from the child's indentation. |
| 1543 | ;; But that would more often be a bad idea: OT1H we generally |
| 1544 | ;; want to reuse the closest similar indentation point, so that |
| 1545 | ;; the user's choice (or the fixindents) are obeyed. But OTOH |
| 1546 | ;; we don't want this to affect "unrelated" parts of the code. |
| 1547 | ;; E.g. a fixindent in the body of a "begin..end" should not |
| 1548 | ;; affect the indentation of the "end". |
| 1549 | (current-column) |
| 1550 | (goto-char (cadr parent)) |
| 1551 | ;; Don't use (smie-indent-virtual :not-hanging) here, because we |
| 1552 | ;; want to jump back over a sequence of same-level ops such as |
| 1553 | ;; a -> b -> c |
| 1554 | ;; -> d |
| 1555 | ;; So as to align with the earliest appropriate place. |
| 1556 | (smie-indent-virtual))) |
| 1557 | (t |
| 1558 | (if (and (= (point) pos) (smie-indent--bolp)) |
| 1559 | ;; Since we started at BOL, we're not computing a virtual |
| 1560 | ;; indentation, and we're still at the starting point, so |
| 1561 | ;; we can't use `current-column' which would cause |
| 1562 | ;; indentation to depend on itself and we can't use |
| 1563 | ;; smie-indent-virtual since that would be an inf-loop. |
| 1564 | nil |
| 1565 | ;; In indent-keyword, if we're indenting `then' wrt `if', we |
| 1566 | ;; want to use indent-virtual rather than use just |
| 1567 | ;; current-column, so that we can apply the (:before . "if") |
| 1568 | ;; rule which does the "else if" dance in SML. But in other |
| 1569 | ;; cases, we do not want to use indent-virtual (e.g. indentation |
| 1570 | ;; of "*" w.r.t "+", or ";" wrt "("). We could just always use |
| 1571 | ;; indent-virtual and then have indent-rules say explicitly to |
| 1572 | ;; use `point' after things like "(" or "+" when they're not at |
| 1573 | ;; EOL, but you'd end up with lots of those rules. |
| 1574 | ;; So we use a heuristic here, which is that we only use virtual |
| 1575 | ;; if the parent is tightly linked to the child token (they're |
| 1576 | ;; part of the same BNF rule). |
| 1577 | (if (car parent) (current-column) (smie-indent-virtual))))))))))) |
| 1578 | |
| 1579 | (defun smie-indent-comment () |
| 1580 | "Compute indentation of a comment." |
| 1581 | ;; Don't do it for virtual indentations. We should normally never be "in |
| 1582 | ;; front of a comment" when doing virtual-indentation anyway. And if we are |
| 1583 | ;; (as can happen in octave-mode), moving forward can lead to inf-loops. |
| 1584 | (and (smie-indent--bolp) |
| 1585 | (let ((pos (point))) |
| 1586 | (save-excursion |
| 1587 | (beginning-of-line) |
| 1588 | (and (re-search-forward comment-start-skip (line-end-position) t) |
| 1589 | (eq pos (or (match-end 1) (match-beginning 0)))))) |
| 1590 | (save-excursion |
| 1591 | (forward-comment (point-max)) |
| 1592 | (skip-chars-forward " \t\r\n") |
| 1593 | (unless |
| 1594 | ;; Don't align with a closer, since the comment is "within" the |
| 1595 | ;; closed element. Don't align with EOB either. |
| 1596 | (save-excursion |
| 1597 | (let ((next (funcall smie-forward-token-function))) |
| 1598 | (or (if (zerop (length next)) |
| 1599 | (or (eobp) (eq (car (syntax-after (point))) 5))) |
| 1600 | (rassoc next smie-closer-alist)))) |
| 1601 | ;; FIXME: We assume here that smie-indent-calculate will compute the |
| 1602 | ;; indentation of the next token based on text before the comment, |
| 1603 | ;; but this is not guaranteed, so maybe we should let |
| 1604 | ;; smie-indent-calculate return some info about which buffer |
| 1605 | ;; position was used as the "indentation base" and check that this |
| 1606 | ;; base is before `pos'. |
| 1607 | (smie-indent-calculate))))) |
| 1608 | |
| 1609 | (defun smie-indent-comment-continue () |
| 1610 | ;; indentation of comment-continue lines. |
| 1611 | (let ((continue (and comment-continue |
| 1612 | (comment-string-strip comment-continue t t)))) |
| 1613 | (and (< 0 (length continue)) |
| 1614 | (looking-at (regexp-quote continue)) (nth 4 (syntax-ppss)) |
| 1615 | (let ((ppss (syntax-ppss))) |
| 1616 | (save-excursion |
| 1617 | (forward-line -1) |
| 1618 | (if (<= (point) (nth 8 ppss)) |
| 1619 | (progn (goto-char (1+ (nth 8 ppss))) (current-column)) |
| 1620 | (skip-chars-forward " \t") |
| 1621 | (if (looking-at (regexp-quote continue)) |
| 1622 | (current-column)))))))) |
| 1623 | |
| 1624 | (defun smie-indent-comment-close () |
| 1625 | (and (boundp 'comment-end-skip) |
| 1626 | comment-end-skip |
| 1627 | (not (looking-at " \t*$")) ;Not just a \n comment-closer. |
| 1628 | (looking-at comment-end-skip) |
| 1629 | (let ((end (match-string 0))) |
| 1630 | (and (nth 4 (syntax-ppss)) |
| 1631 | (save-excursion |
| 1632 | (goto-char (nth 8 (syntax-ppss))) |
| 1633 | (and (looking-at comment-start-skip) |
| 1634 | (let ((start (match-string 0))) |
| 1635 | ;; Align the common substring between starter |
| 1636 | ;; and ender, if possible. |
| 1637 | (if (string-match "\\(.+\\).*\n\\(.*?\\)\\1" |
| 1638 | (concat start "\n" end)) |
| 1639 | (+ (current-column) (match-beginning 0) |
| 1640 | (- (match-beginning 2) (match-end 2))) |
| 1641 | (current-column))))))))) |
| 1642 | |
| 1643 | (defun smie-indent-comment-inside () |
| 1644 | (and (nth 4 (syntax-ppss)) |
| 1645 | 'noindent)) |
| 1646 | |
| 1647 | (defun smie-indent-inside-string () |
| 1648 | (and (nth 3 (syntax-ppss)) |
| 1649 | 'noindent)) |
| 1650 | |
| 1651 | (defun smie-indent-after-keyword () |
| 1652 | ;; Indentation right after a special keyword. |
| 1653 | (save-excursion |
| 1654 | (let* ((pos (point)) |
| 1655 | (toklevel (smie-indent-backward-token)) |
| 1656 | (tok (car toklevel))) |
| 1657 | (cond |
| 1658 | ((null toklevel) nil) |
| 1659 | ((smie-indent--rule :after tok pos nil (point))) |
| 1660 | ;; The default indentation after a keyword/operator is |
| 1661 | ;; 0 for infix, t for prefix, and use another rule |
| 1662 | ;; for postfix. |
| 1663 | ((not (numberp (nth 2 toklevel))) nil) ;A closer. |
| 1664 | ((or (not (numberp (nth 1 toklevel))) ;An opener. |
| 1665 | (rassoc tok smie-closer-alist)) ;An inner. |
| 1666 | (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ; |
| 1667 | (t (smie-indent-virtual)))))) ;An infix. |
| 1668 | |
| 1669 | (defun smie-indent-exps () |
| 1670 | ;; Indentation of sequences of simple expressions without |
| 1671 | ;; intervening keywords or operators. E.g. "a b c" or "g (balbla) f". |
| 1672 | ;; Can be a list of expressions or a function call. |
| 1673 | ;; If it's a function call, the first element is special (it's the |
| 1674 | ;; function). We distinguish function calls from mere lists of |
| 1675 | ;; expressions based on whether the preceding token is listed in |
| 1676 | ;; the `list-intro' entry of smie-indent-rules. |
| 1677 | ;; |
| 1678 | ;; TODO: to indent Lisp code, we should add a way to specify |
| 1679 | ;; particular indentation for particular args depending on the |
| 1680 | ;; function (which would require always skipping back until the |
| 1681 | ;; function). |
| 1682 | ;; TODO: to indent C code, such as "if (...) {...}" we might need |
| 1683 | ;; to add similar indentation hooks for particular positions, but |
| 1684 | ;; based on the preceding token rather than based on the first exp. |
| 1685 | (save-excursion |
| 1686 | (let ((positions nil) |
| 1687 | arg) |
| 1688 | (while (and (null (car (smie-backward-sexp))) |
| 1689 | (push (point) positions) |
| 1690 | (not (smie-indent--bolp)))) |
| 1691 | (save-excursion |
| 1692 | ;; Figure out if the atom we just skipped is an argument rather |
| 1693 | ;; than a function. |
| 1694 | (setq arg |
| 1695 | (or (null (car (smie-backward-sexp))) |
| 1696 | (funcall smie-rules-function :list-intro |
| 1697 | (funcall smie-backward-token-function))))) |
| 1698 | (cond |
| 1699 | ((null positions) |
| 1700 | ;; We're the first expression of the list. In that case, the |
| 1701 | ;; indentation should be (have been) determined by its context. |
| 1702 | nil) |
| 1703 | (arg |
| 1704 | ;; There's a previous element, and it's not special (it's not |
| 1705 | ;; the function), so let's just align with that one. |
| 1706 | (goto-char (car positions)) |
| 1707 | (current-column)) |
| 1708 | ((cdr positions) |
| 1709 | ;; We skipped some args plus the function and bumped into something. |
| 1710 | ;; Align with the first arg. |
| 1711 | (goto-char (cadr positions)) |
| 1712 | (current-column)) |
| 1713 | (positions |
| 1714 | ;; We're the first arg. |
| 1715 | (goto-char (car positions)) |
| 1716 | (+ (smie-indent--offset 'args) |
| 1717 | ;; We used to use (smie-indent-virtual), but that |
| 1718 | ;; doesn't seem right since it might then indent args less than |
| 1719 | ;; the function itself. |
| 1720 | (current-column))))))) |
| 1721 | |
| 1722 | (defvar smie-indent-functions |
| 1723 | '(smie-indent-fixindent smie-indent-bob smie-indent-close |
| 1724 | smie-indent-comment smie-indent-comment-continue smie-indent-comment-close |
| 1725 | smie-indent-comment-inside smie-indent-inside-string |
| 1726 | smie-indent-keyword smie-indent-after-keyword |
| 1727 | smie-indent-exps) |
| 1728 | "Functions to compute the indentation. |
| 1729 | Each function is called with no argument, shouldn't move point, and should |
| 1730 | return either nil if it has no opinion, or an integer representing the column |
| 1731 | to which that point should be aligned, if we were to reindent it.") |
| 1732 | |
| 1733 | (defun smie-indent-calculate () |
| 1734 | "Compute the indentation to use for point." |
| 1735 | (run-hook-with-args-until-success 'smie-indent-functions)) |
| 1736 | |
| 1737 | (defun smie-indent-line () |
| 1738 | "Indent current line using the SMIE indentation engine." |
| 1739 | (interactive) |
| 1740 | (let* ((savep (point)) |
| 1741 | (indent (or (with-demoted-errors |
| 1742 | (save-excursion |
| 1743 | (forward-line 0) |
| 1744 | (skip-chars-forward " \t") |
| 1745 | (if (>= (point) savep) (setq savep nil)) |
| 1746 | (or (smie-indent-calculate) 0))) |
| 1747 | 0))) |
| 1748 | (if (not (numberp indent)) |
| 1749 | ;; If something funny is used (e.g. `noindent'), return it. |
| 1750 | indent |
| 1751 | (if (< indent 0) (setq indent 0)) ;Just in case. |
| 1752 | (if savep |
| 1753 | (save-excursion (indent-line-to indent)) |
| 1754 | (indent-line-to indent))))) |
| 1755 | |
| 1756 | (defun smie-auto-fill (do-auto-fill) |
| 1757 | (let ((fc (current-fill-column))) |
| 1758 | (when (and fc (> (current-column) fc)) |
| 1759 | ;; The loop below presumes BOL is outside of strings or comments. Also, |
| 1760 | ;; sometimes we prefer to fill the comment than the code around it. |
| 1761 | (unless (or (nth 8 (save-excursion |
| 1762 | (syntax-ppss (line-beginning-position)))) |
| 1763 | (nth 4 (save-excursion |
| 1764 | (move-to-column fc) |
| 1765 | (syntax-ppss)))) |
| 1766 | (while |
| 1767 | (and (with-demoted-errors |
| 1768 | (save-excursion |
| 1769 | (let ((end (point)) |
| 1770 | (bsf nil) ;Best-so-far. |
| 1771 | (gain 0)) |
| 1772 | (beginning-of-line) |
| 1773 | (while (progn |
| 1774 | (smie-indent-forward-token) |
| 1775 | (and (<= (point) end) |
| 1776 | (<= (current-column) fc))) |
| 1777 | ;; FIXME? `smie-indent-calculate' can (and often |
| 1778 | ;; does) return a result that actually depends on the |
| 1779 | ;; presence/absence of a newline, so the gain computed |
| 1780 | ;; here may not be accurate, but in practice it seems |
| 1781 | ;; to work well enough. |
| 1782 | (skip-chars-forward " \t") |
| 1783 | (let* ((newcol (smie-indent-calculate)) |
| 1784 | (newgain (- (current-column) newcol))) |
| 1785 | (when (> newgain gain) |
| 1786 | (setq gain newgain) |
| 1787 | (setq bsf (point))))) |
| 1788 | (when (> gain 0) |
| 1789 | (goto-char bsf) |
| 1790 | (newline-and-indent) |
| 1791 | 'done)))) |
| 1792 | (> (current-column) fc)))) |
| 1793 | (when (> (current-column) fc) |
| 1794 | (funcall do-auto-fill))))) |
| 1795 | |
| 1796 | |
| 1797 | (defun smie-setup (grammar rules-function &rest keywords) |
| 1798 | "Setup SMIE navigation and indentation. |
| 1799 | GRAMMAR is a grammar table generated by `smie-prec2->grammar'. |
| 1800 | RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. |
| 1801 | KEYWORDS are additional arguments, which can use the following keywords: |
| 1802 | - :forward-token FUN |
| 1803 | - :backward-token FUN" |
| 1804 | (setq-local smie-rules-function rules-function) |
| 1805 | (setq-local smie-grammar grammar) |
| 1806 | (setq-local indent-line-function #'smie-indent-line) |
| 1807 | (add-function :around (local 'normal-auto-fill-function) #'smie-auto-fill) |
| 1808 | (setq-local forward-sexp-function #'smie-forward-sexp-command) |
| 1809 | (while keywords |
| 1810 | (let ((k (pop keywords)) |
| 1811 | (v (pop keywords))) |
| 1812 | (pcase k |
| 1813 | (`:forward-token |
| 1814 | (set (make-local-variable 'smie-forward-token-function) v)) |
| 1815 | (`:backward-token |
| 1816 | (set (make-local-variable 'smie-backward-token-function) v)) |
| 1817 | (_ (message "smie-setup: ignoring unknown keyword %s" k))))) |
| 1818 | (let ((ca (cdr (assq :smie-closer-alist grammar)))) |
| 1819 | (when ca |
| 1820 | (setq-local smie-closer-alist ca) |
| 1821 | ;; Only needed for interactive calls to blink-matching-open. |
| 1822 | (setq-local blink-matching-check-function #'smie-blink-matching-check) |
| 1823 | (add-hook 'post-self-insert-hook |
| 1824 | #'smie-blink-matching-open 'append 'local) |
| 1825 | (add-function :around (local 'show-paren-data-function) |
| 1826 | #'smie--matching-block-data) |
| 1827 | ;; Setup smie-blink-matching-triggers. Rather than wait for SPC to |
| 1828 | ;; blink, try to blink as soon as we type the last char of a block ender. |
| 1829 | (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp)) |
| 1830 | (triggers ()) |
| 1831 | closer) |
| 1832 | (while (setq closer (pop closers)) |
| 1833 | (unless |
| 1834 | ;; FIXME: this eliminates prefixes of other closers, but we |
| 1835 | ;; should probably eliminate prefixes of other keywords as well. |
| 1836 | (and closers (string-prefix-p closer (car closers))) |
| 1837 | (push (aref closer (1- (length closer))) triggers))) |
| 1838 | (setq-local smie-blink-matching-triggers |
| 1839 | (append smie-blink-matching-triggers |
| 1840 | (delete-dups triggers))))))) |
| 1841 | |
| 1842 | (declare-function edebug-instrument-function "edebug" (func)) |
| 1843 | |
| 1844 | (defun smie-edebug () |
| 1845 | "Instrument the `smie-rules-function' for Edebug." |
| 1846 | (interactive) |
| 1847 | (require 'edebug) |
| 1848 | (if (symbolp smie-rules-function) |
| 1849 | (edebug-instrument-function smie-rules-function) |
| 1850 | (error "Sorry, don't know how to instrument a lambda expression"))) |
| 1851 | |
| 1852 | (defun smie--next-indent-change () |
| 1853 | "Go to the next line that needs to be reindented (and reindent it)." |
| 1854 | (interactive) |
| 1855 | (while |
| 1856 | (let ((tick (buffer-chars-modified-tick))) |
| 1857 | (indent-according-to-mode) |
| 1858 | (eq tick (buffer-chars-modified-tick))) |
| 1859 | (forward-line 1))) |
| 1860 | |
| 1861 | ;;; User configuration |
| 1862 | |
| 1863 | ;; This is designed to be a completely independent "module", so we can play |
| 1864 | ;; with various kinds of smie-config modules without having to change the core. |
| 1865 | |
| 1866 | ;; This smie-config module is fairly primitive and suffers from serious |
| 1867 | ;; restrictions: |
| 1868 | ;; - You can only change a returned offset, so you can't change the offset |
| 1869 | ;; passed to smie-rule-parent, nor can you change the object with which |
| 1870 | ;; to align (in general). |
| 1871 | ;; - The rewrite rule can only distinguish cases based on the kind+token arg |
| 1872 | ;; and smie-rules-function's return value, so you can't distinguish cases |
| 1873 | ;; where smie-rules-function returns the same value. |
| 1874 | ;; - Since config-rules depend on the return value of smie-rules-function, any |
| 1875 | ;; config change that modifies this return value (e.g. changing |
| 1876 | ;; foo-indent-basic) ends up invalidating config-rules. |
| 1877 | ;; This last one is a serious problem since it means that file-local |
| 1878 | ;; config-rules will only work if the user hasn't changed foo-indent-basic. |
| 1879 | ;; One possible way to change it is to modify smie-rules-functions so they can |
| 1880 | ;; return special symbols like +, ++, -, etc. Or make them use a new |
| 1881 | ;; smie-rule-basic function which can then be used to know when a returned |
| 1882 | ;; offset was computed based on foo-indent-basic. |
| 1883 | |
| 1884 | (defvar-local smie-config--mode-local nil |
| 1885 | "Indentation config rules installed for this major mode. |
| 1886 | Typically manipulated from the major-mode's hook.") |
| 1887 | (defvar-local smie-config--buffer-local nil |
| 1888 | "Indentation config rules installed for this very buffer. |
| 1889 | E.g. provided via a file-local call to `smie-config-local'.") |
| 1890 | (defvar smie-config--trace nil |
| 1891 | "Variable used to trace calls to `smie-rules-function'.") |
| 1892 | |
| 1893 | (defun smie-config--advice (orig kind token) |
| 1894 | (let* ((ret (funcall orig kind token)) |
| 1895 | (sig (list kind token ret)) |
| 1896 | (brule (rassoc sig smie-config--buffer-local)) |
| 1897 | (mrule (rassoc sig smie-config--mode-local))) |
| 1898 | (when smie-config--trace |
| 1899 | (setq smie-config--trace (or brule mrule))) |
| 1900 | (cond |
| 1901 | (brule (car brule)) |
| 1902 | (mrule (car mrule)) |
| 1903 | (t ret)))) |
| 1904 | |
| 1905 | (defun smie-config--mode-hook (rules) |
| 1906 | (setq smie-config--mode-local |
| 1907 | (append rules smie-config--mode-local)) |
| 1908 | (add-function :around (local 'smie-rules-function) #'smie-config--advice)) |
| 1909 | |
| 1910 | (defvar smie-config--modefuns nil) |
| 1911 | |
| 1912 | (defun smie-config--setter (var value) |
| 1913 | (setq-default var value) |
| 1914 | (let ((old-modefuns smie-config--modefuns)) |
| 1915 | (setq smie-config--modefuns nil) |
| 1916 | (pcase-dolist (`(,mode . ,rules) value) |
| 1917 | (let ((modefunname (intern (format "smie-config--modefun-%s" mode)))) |
| 1918 | (fset modefunname (lambda () (smie-config--mode-hook rules))) |
| 1919 | (push modefunname smie-config--modefuns) |
| 1920 | (add-hook (intern (format "%s-hook" mode)) modefunname))) |
| 1921 | ;; Neuter any left-over previously installed hook. |
| 1922 | (dolist (modefun old-modefuns) |
| 1923 | (unless (memq modefun smie-config--modefuns) |
| 1924 | (fset modefun #'ignore))))) |
| 1925 | |
| 1926 | (defcustom smie-config nil |
| 1927 | ;; FIXME: there should be a file-local equivalent. |
| 1928 | "User configuration of SMIE indentation. |
| 1929 | This is a list of elements (MODE . RULES), where RULES is a list |
| 1930 | of elements describing when and how to change the indentation rules. |
| 1931 | Each RULE element should be of the form (NEW KIND TOKEN NORMAL), |
| 1932 | where KIND and TOKEN are the elements passed to `smie-rules-function', |
| 1933 | NORMAL is the value returned by `smie-rules-function' and NEW is the |
| 1934 | value with which to replace it." |
| 1935 | :version "24.4" |
| 1936 | ;; FIXME improve value-type. |
| 1937 | :type '(choice (const nil) |
| 1938 | (alist :key-type symbol)) |
| 1939 | :initialize 'custom-initialize-default |
| 1940 | :set #'smie-config--setter) |
| 1941 | |
| 1942 | (defun smie-config-local (rules) |
| 1943 | "Add RULES as local indentation rules to use in this buffer. |
| 1944 | These replace any previous local rules, but supplement the rules |
| 1945 | specified in `smie-config'." |
| 1946 | (setq smie-config--buffer-local rules) |
| 1947 | (add-function :around (local 'smie-rules-function) #'smie-config--advice)) |
| 1948 | |
| 1949 | ;; Make it so we can set those in the file-local block. |
| 1950 | ;; FIXME: Better would be to be able to write "smie-config-local: (...)" rather |
| 1951 | ;; than "eval: (smie-config-local '(...))". |
| 1952 | (put 'smie-config-local 'safe-local-eval-function t) |
| 1953 | |
| 1954 | (defun smie-config--get-trace () |
| 1955 | (save-excursion |
| 1956 | (forward-line 0) |
| 1957 | (skip-chars-forward " \t") |
| 1958 | (let* ((trace ()) |
| 1959 | (srf-fun (lambda (orig kind token) |
| 1960 | (let* ((pos (point)) |
| 1961 | (smie-config--trace t) |
| 1962 | (res (funcall orig kind token))) |
| 1963 | (push (if (consp smie-config--trace) |
| 1964 | (list pos kind token res smie-config--trace) |
| 1965 | (list pos kind token res)) |
| 1966 | trace) |
| 1967 | res)))) |
| 1968 | (unwind-protect |
| 1969 | (progn |
| 1970 | (add-function :around (local 'smie-rules-function) srf-fun) |
| 1971 | (cons (smie-indent-calculate) |
| 1972 | trace)) |
| 1973 | (remove-function (local 'smie-rules-function) srf-fun))))) |
| 1974 | |
| 1975 | (defun smie-config-show-indent (&optional arg) |
| 1976 | "Display the SMIE rules that are used to indent the current line. |
| 1977 | If prefix ARG is given, then move briefly point to the buffer |
| 1978 | position corresponding to each rule." |
| 1979 | (interactive "P") |
| 1980 | (let ((trace (cdr (smie-config--get-trace)))) |
| 1981 | (cond |
| 1982 | ((null trace) (message "No SMIE rules involved")) |
| 1983 | ((not arg) |
| 1984 | (message "Rules used: %s" |
| 1985 | (mapconcat (lambda (elem) |
| 1986 | (pcase-let ((`(,_pos ,kind ,token ,res ,rewrite) |
| 1987 | elem)) |
| 1988 | (format "%S %S -> %S%s" kind token res |
| 1989 | (if (null rewrite) "" |
| 1990 | (format "(via %S)" (nth 3 rewrite)))))) |
| 1991 | trace |
| 1992 | ", "))) |
| 1993 | (t |
| 1994 | (save-excursion |
| 1995 | (pcase-dolist (`(,pos ,kind ,token ,res ,rewrite) trace) |
| 1996 | (message "%S %S -> %S%s" kind token res |
| 1997 | (if (null rewrite) "" |
| 1998 | (format "(via %S)" (nth 3 rewrite)))) |
| 1999 | (goto-char pos) |
| 2000 | (sit-for blink-matching-delay))))))) |
| 2001 | |
| 2002 | (defun smie-config--guess-value (sig) |
| 2003 | (add-function :around (local 'smie-rules-function) #'smie-config--advice) |
| 2004 | (let* ((rule (cons 0 sig)) |
| 2005 | (smie-config--buffer-local (cons rule smie-config--buffer-local)) |
| 2006 | (goal (current-indentation)) |
| 2007 | (cur (smie-indent-calculate))) |
| 2008 | (cond |
| 2009 | ((and (eq goal |
| 2010 | (progn (setf (car rule) (- goal cur)) |
| 2011 | (smie-indent-calculate)))) |
| 2012 | (- goal cur))))) |
| 2013 | |
| 2014 | (defun smie-config-set-indent () |
| 2015 | "Add a rule to adjust the indentation of current line." |
| 2016 | (interactive) |
| 2017 | (let* ((trace (cdr (smie-config--get-trace))) |
| 2018 | (_ (unless trace (error "No SMIE rules involved"))) |
| 2019 | (sig (if (null (cdr trace)) |
| 2020 | (pcase-let* ((elem (car trace)) |
| 2021 | (`(,_pos ,kind ,token ,res ,rewrite) elem)) |
| 2022 | (list kind token (or (nth 3 rewrite) res))) |
| 2023 | (let* ((choicestr |
| 2024 | (completing-read |
| 2025 | "Adjust rule: " |
| 2026 | (mapcar (lambda (elem) |
| 2027 | (format "%s %S" |
| 2028 | (substring (symbol-name (cadr elem)) |
| 2029 | 1) |
| 2030 | (nth 2 elem))) |
| 2031 | trace) |
| 2032 | nil t nil nil |
| 2033 | nil)) ;FIXME: Provide good default! |
| 2034 | (choicelst (car (read-from-string |
| 2035 | (concat "(:" choicestr ")"))))) |
| 2036 | (catch 'found |
| 2037 | (pcase-dolist (`(,_pos ,kind ,token ,res ,rewrite) trace) |
| 2038 | (when (and (eq kind (car choicelst)) |
| 2039 | (equal token (nth 1 choicelst))) |
| 2040 | (throw 'found (list kind token |
| 2041 | (or (nth 3 rewrite) res))))))))) |
| 2042 | (default-new (smie-config--guess-value sig)) |
| 2043 | (newstr (read-string (format "Adjust rule (%S %S -> %S) to%s: " |
| 2044 | (nth 0 sig) (nth 1 sig) (nth 2 sig) |
| 2045 | (if (not default-new) "" |
| 2046 | (format " (default %S)" default-new))) |
| 2047 | nil nil (format "%S" default-new))) |
| 2048 | (new (car (read-from-string newstr)))) |
| 2049 | (let ((old (rassoc sig smie-config--buffer-local))) |
| 2050 | (when old |
| 2051 | (setq smie-config--buffer-local |
| 2052 | (remove old smie-config--buffer-local)))) |
| 2053 | (push (cons new sig) smie-config--buffer-local) |
| 2054 | (message "Added rule %S %S -> %S (via %S)" |
| 2055 | (nth 0 sig) (nth 1 sig) new (nth 2 sig)) |
| 2056 | (add-function :around (local 'smie-rules-function) #'smie-config--advice))) |
| 2057 | |
| 2058 | (defun smie-config--guess (beg end) |
| 2059 | (let ((otraces (make-hash-table :test #'equal)) |
| 2060 | (smie-config--buffer-local nil) |
| 2061 | (smie-config--mode-local nil) |
| 2062 | (pr (make-progress-reporter "Analyzing the buffer" beg end))) |
| 2063 | |
| 2064 | ;; First, lets get the indentation traces and offsets for the region. |
| 2065 | (save-excursion |
| 2066 | (goto-char beg) |
| 2067 | (forward-line 0) |
| 2068 | (while (< (point) end) |
| 2069 | (skip-chars-forward " \t") |
| 2070 | (unless (eolp) ;Skip empty lines. |
| 2071 | (progress-reporter-update pr (point)) |
| 2072 | (let* ((itrace (smie-config--get-trace)) |
| 2073 | (nindent (car itrace)) |
| 2074 | (trace (mapcar #'cdr (cdr itrace))) |
| 2075 | (cur (current-indentation))) |
| 2076 | (when (numberp nindent) ;Skip `noindent' and friends. |
| 2077 | (cl-incf (gethash (cons (- cur nindent) trace) otraces 0))))) |
| 2078 | (forward-line 1))) |
| 2079 | (progress-reporter-done pr) |
| 2080 | |
| 2081 | ;; Second, compile the data. Our algorithm only knows how to adjust rules |
| 2082 | ;; where the smie-rules-function returns an integer. We call those |
| 2083 | ;; "adjustable sigs". We build a table mapping each adjustable sig |
| 2084 | ;; to its data, describing the total number of times we encountered it, |
| 2085 | ;; the offsets found, and the traces in which it was found. |
| 2086 | (message "Guessing...") |
| 2087 | (let ((sigs (make-hash-table :test #'equal))) |
| 2088 | (maphash (lambda (otrace count) |
| 2089 | (let ((offset (car otrace)) |
| 2090 | (trace (cdr otrace)) |
| 2091 | (double nil)) |
| 2092 | (let ((sigs trace)) |
| 2093 | (while sigs |
| 2094 | (let ((sig (pop sigs))) |
| 2095 | (if (and (integerp (nth 2 sig)) (member sig sigs)) |
| 2096 | (setq double t))))) |
| 2097 | (if double |
| 2098 | ;; Disregard those traces where an adjustable sig |
| 2099 | ;; appears twice, because the rest of the code assumes |
| 2100 | ;; that adding a rule to add an offset N will change the |
| 2101 | ;; end result by N rather than 2*N or more. |
| 2102 | nil |
| 2103 | (dolist (sig trace) |
| 2104 | (if (not (integerp (nth 2 sig))) |
| 2105 | ;; Disregard those sigs that return nil or a column, |
| 2106 | ;; because our algorithm doesn't know how to adjust |
| 2107 | ;; them anyway. |
| 2108 | nil |
| 2109 | (let ((sig-data (or (gethash sig sigs) |
| 2110 | (let ((data (list 0 nil nil))) |
| 2111 | (puthash sig data sigs) |
| 2112 | data)))) |
| 2113 | (cl-incf (nth 0 sig-data) count) |
| 2114 | (push (cons count otrace) (nth 2 sig-data)) |
| 2115 | (let ((sig-off-data |
| 2116 | (or (assq offset (nth 1 sig-data)) |
| 2117 | (let ((off-data (cons offset 0))) |
| 2118 | (push off-data (nth 1 sig-data)) |
| 2119 | off-data)))) |
| 2120 | (cl-incf (cdr sig-off-data) count)))))))) |
| 2121 | otraces) |
| 2122 | |
| 2123 | ;; Finally, guess the indentation rules. |
| 2124 | (let ((ssigs nil) |
| 2125 | (rules nil)) |
| 2126 | ;; Sort the sigs by frequency of occurrence. |
| 2127 | (maphash (lambda (sig sig-data) (push (cons sig sig-data) ssigs)) sigs) |
| 2128 | (setq ssigs (sort ssigs (lambda (sd1 sd2) (> (cadr sd1) (cadr sd2))))) |
| 2129 | (while ssigs |
| 2130 | (pcase-let ((`(,sig ,total ,off-alist ,cotraces) (pop ssigs))) |
| 2131 | (cl-assert (= total (apply #'+ (mapcar #'cdr off-alist)))) |
| 2132 | (let* ((sorted-off-alist |
| 2133 | (sort off-alist (lambda (x y) (> (cdr x) (cdr y))))) |
| 2134 | (offset (caar sorted-off-alist))) |
| 2135 | (if (zerop offset) |
| 2136 | ;; Nothing to do with this sig; indentation is |
| 2137 | ;; correct already. |
| 2138 | nil |
| 2139 | (push (cons (+ offset (nth 2 sig)) sig) rules) |
| 2140 | ;; Adjust the rest of the data. |
| 2141 | (pcase-dolist ((and cotrace `(,count ,toffset . ,trace)) |
| 2142 | cotraces) |
| 2143 | (setf (nth 1 cotrace) (- toffset offset)) |
| 2144 | (dolist (sig trace) |
| 2145 | (let ((sig-data (cdr (assq sig ssigs)))) |
| 2146 | (when sig-data |
| 2147 | (let* ((ooff-data (assq toffset (nth 1 sig-data))) |
| 2148 | (noffset (- toffset offset)) |
| 2149 | (noff-data |
| 2150 | (or (assq noffset (nth 1 sig-data)) |
| 2151 | (let ((off-data (cons noffset 0))) |
| 2152 | (push off-data (nth 1 sig-data)) |
| 2153 | off-data)))) |
| 2154 | (cl-assert (>= (cdr ooff-data) count)) |
| 2155 | (cl-decf (cdr ooff-data) count) |
| 2156 | (cl-incf (cdr noff-data) count)))))))))) |
| 2157 | (message "Guessing...done") |
| 2158 | rules)))) |
| 2159 | |
| 2160 | (defun smie-config-guess () |
| 2161 | "Try and figure out this buffer's indentation settings. |
| 2162 | To save the result for future sessions, use `smie-config-save'." |
| 2163 | (interactive) |
| 2164 | (if (eq smie-grammar 'unset) |
| 2165 | (user-error "This buffer does not seem to be using SMIE")) |
| 2166 | (let ((config (smie-config--guess (point-min) (point-max)))) |
| 2167 | (cond |
| 2168 | ((null config) (message "Nothing to change")) |
| 2169 | ((null smie-config--buffer-local) |
| 2170 | (smie-config-local config) |
| 2171 | (message "Local rules set")) |
| 2172 | ((y-or-n-p "Replace existing local config? ") |
| 2173 | (message "Local rules replaced") |
| 2174 | (smie-config-local config)) |
| 2175 | ((y-or-n-p "Merge with existing local config? ") |
| 2176 | (message "Local rules adjusted") |
| 2177 | (smie-config-local (append config smie-config--buffer-local))) |
| 2178 | (t |
| 2179 | (message "Rules guessed: %S" config))))) |
| 2180 | |
| 2181 | (defun smie-config-save () |
| 2182 | "Save local rules for use with this major mode. |
| 2183 | One way to generate local rules is the command `smie-config-guess'." |
| 2184 | (interactive) |
| 2185 | (cond |
| 2186 | ((null smie-config--buffer-local) |
| 2187 | (message "No local rules to save")) |
| 2188 | (t |
| 2189 | (let* ((existing (assq major-mode smie-config)) |
| 2190 | (config |
| 2191 | (cond ((null existing) |
| 2192 | (message "Local rules saved in `smie-config'") |
| 2193 | smie-config--buffer-local) |
| 2194 | ((y-or-n-p "Replace the existing mode's config? ") |
| 2195 | (message "Mode rules replaced in `smie-config'") |
| 2196 | smie-config--buffer-local) |
| 2197 | ((y-or-n-p "Merge with existing mode's config? ") |
| 2198 | (message "Mode rules adjusted in `smie-config'") |
| 2199 | (append smie-config--buffer-local (cdr existing))) |
| 2200 | (t (error "Abort"))))) |
| 2201 | (if existing |
| 2202 | (setcdr existing config) |
| 2203 | (push (cons major-mode config) smie-config)) |
| 2204 | (setq smie-config--mode-local config) |
| 2205 | (kill-local-variable 'smie-config--buffer-local) |
| 2206 | (customize-mark-as-set 'smie-config))))) |
| 2207 | |
| 2208 | (provide 'smie) |
| 2209 | ;;; smie.el ends here |