diff options
| author | Stefan Monnier | 2010-11-07 10:52:33 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2010-11-07 10:52:33 -0500 |
| commit | 7f925a67c1c716fc1ac55d38e02410f6cd2bde89 (patch) | |
| tree | ca9ea9a58182ccccd0923deaddc76fcd987b225a | |
| parent | e4dbd3e26799ee5a239fa2c595da3be64b7e7b13 (diff) | |
| download | emacs-7f925a67c1c716fc1ac55d38e02410f6cd2bde89.tar.gz emacs-7f925a67c1c716fc1ac55d38e02410f6cd2bde89.zip | |
* lisp/emacs-lisp/smie.el: New package.
| -rw-r--r-- | etc/NEWS | 5 | ||||
| -rw-r--r-- | lisp/ChangeLog | 16 | ||||
| -rw-r--r-- | lisp/Makefile.in | 1 | ||||
| -rw-r--r-- | lisp/emacs-lisp/smie.el | 1462 |
4 files changed, 1477 insertions, 7 deletions
| @@ -82,7 +82,10 @@ produce an up to date diff. | |||
| 82 | 82 | ||
| 83 | 83 | ||
| 84 | * New Modes and Packages in Emacs 23.3 | 84 | * New Modes and Packages in Emacs 23.3 |
| 85 | 85 | ** smie.el is a generic navigation and indentation engine. | |
| 86 | It takes a simple BNF description of the grammar, and provides both | ||
| 87 | sexp-style navigation (jumping over begin..end pairs) as well as | ||
| 88 | indentation, which can be adjusted via ad-hoc indentation rules. | ||
| 86 | 89 | ||
| 87 | * Incompatible Lisp Changes in Emacs 23.3 | 90 | * Incompatible Lisp Changes in Emacs 23.3 |
| 88 | 91 | ||
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5dafd64e1d3..33d1f96c145 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,7 +1,11 @@ | |||
| 1 | 2010-11-07 Stefan Monnier <monnier@iro.umontreal.ca> | ||
| 2 | |||
| 3 | * emacs-lisp/smie.el: New package. | ||
| 4 | |||
| 1 | 2010-11-06 Michael Albinus <michael.albinus@gmx.de> | 5 | 2010-11-06 Michael Albinus <michael.albinus@gmx.de> |
| 2 | 6 | ||
| 3 | * files.el (backup-by-copying-when-mismatch): Set | 7 | * files.el (backup-by-copying-when-mismatch): |
| 4 | `permanent-local' property. | 8 | Set `permanent-local' property. |
| 5 | 9 | ||
| 6 | * net/tramp.el (tramp-handle-insert-file-contents): Do not set | 10 | * net/tramp.el (tramp-handle-insert-file-contents): Do not set |
| 7 | `permanent-local' property for `backup-by-copying-when-mismatch'. | 11 | `permanent-local' property for `backup-by-copying-when-mismatch'. |
| @@ -16,11 +20,11 @@ | |||
| 16 | 20 | ||
| 17 | 2010-11-07 Wilson Snyder <wsnyder@wsnyder.org> | 21 | 2010-11-07 Wilson Snyder <wsnyder@wsnyder.org> |
| 18 | 22 | ||
| 19 | * progmodes/verilog-mode.el (verilog-insert-one-definition) | 23 | * progmodes/verilog-mode.el (verilog-insert-one-definition) |
| 20 | (verilog-read-decls, verilog-read-sub-decls-sig): Fix AUTOWIRE and | 24 | (verilog-read-decls, verilog-read-sub-decls-sig): Fix AUTOWIRE and |
| 21 | AUTOINOUT for SV style multidimensional arrays, bug294. Reported | 25 | AUTOINOUT for SV style multidimensional arrays, bug294. |
| 22 | by Eric Mastromarchi. | 26 | Reported by Eric Mastromarchi. |
| 23 | (verilog-preprocess): Use with-current-buffer and | 27 | (verilog-preprocess): Use with-current-buffer and |
| 24 | font-lock-fontify-buffer to cleanup style issues. | 28 | font-lock-fontify-buffer to cleanup style issues. |
| 25 | 29 | ||
| 26 | 2010-11-05 Michael Albinus <michael.albinus@gmx.de> | 30 | 2010-11-05 Michael Albinus <michael.albinus@gmx.de> |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 7629316dc63..dd93ec44e93 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -559,6 +559,7 @@ ELCFILES = \ | |||
| 559 | $(lisp)/emacs-lisp/ring.elc \ | 559 | $(lisp)/emacs-lisp/ring.elc \ |
| 560 | $(lisp)/emacs-lisp/rx.elc \ | 560 | $(lisp)/emacs-lisp/rx.elc \ |
| 561 | $(lisp)/emacs-lisp/shadow.elc \ | 561 | $(lisp)/emacs-lisp/shadow.elc \ |
| 562 | $(lisp)/emacs-lisp/smie.elc \ | ||
| 562 | $(lisp)/emacs-lisp/sregex.elc \ | 563 | $(lisp)/emacs-lisp/sregex.elc \ |
| 563 | $(lisp)/emacs-lisp/syntax.elc \ | 564 | $(lisp)/emacs-lisp/syntax.elc \ |
| 564 | $(lisp)/emacs-lisp/tcover-ses.elc \ | 565 | $(lisp)/emacs-lisp/tcover-ses.elc \ |
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el new file mode 100644 index 00000000000..03c03126d2f --- /dev/null +++ b/lisp/emacs-lisp/smie.el | |||
| @@ -0,0 +1,1462 @@ | |||
| 1 | ;;; smie.el --- Simple Minded Indentation Engine | ||
| 2 | |||
| 3 | ;; Copyright (C) 2010 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://www.cs.vu.nl/~dick/PTAPG.html). | ||
| 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 | ;;; Code: | ||
| 67 | |||
| 68 | ;; FIXME: I think the behavior on empty lines is wrong. It shouldn't | ||
| 69 | ;; look at the next token on subsequent lines. | ||
| 70 | |||
| 71 | (eval-when-compile (require 'cl)) | ||
| 72 | |||
| 73 | (defgroup smie nil | ||
| 74 | "Simple Minded Indentation Engine." | ||
| 75 | :group 'languages) | ||
| 76 | |||
| 77 | (defvar comment-continue) | ||
| 78 | (declare-function comment-string-strip "newcomment" (str beforep afterp)) | ||
| 79 | |||
| 80 | ;;; Building precedence level tables from BNF specs. | ||
| 81 | |||
| 82 | ;; We have 4 different representations of a "grammar": | ||
| 83 | ;; - a BNF table, which is a list of BNF rules of the form | ||
| 84 | ;; (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens) | ||
| 85 | ;; or nonterminals. Any element in these lists which does not appear as | ||
| 86 | ;; the `car' of a BNF rule is taken to be a terminal. | ||
| 87 | ;; - A list of precedences (key word "precs"), is a list, sorted | ||
| 88 | ;; from lowest to highest precedence, of precedence classes that | ||
| 89 | ;; have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where | ||
| 90 | ;; ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'. | ||
| 91 | ;; - a 2 dimensional precedence table (key word "prec2"), is a 2D | ||
| 92 | ;; table recording the precedence relation (can be `<', `=', `>', or | ||
| 93 | ;; nil) between each pair of tokens. | ||
| 94 | ;; - a precedence-level table (key word "grammar"), which is a alist | ||
| 95 | ;; giving for each token its left and right precedence level (a | ||
| 96 | ;; number or nil). This is used in `smie-grammar'. | ||
| 97 | ;; The prec2 tables are only intermediate data structures: the source | ||
| 98 | ;; code normally provides a mix of BNF and precs tables, and then | ||
| 99 | ;; turns them into a levels table, which is what's used by the rest of | ||
| 100 | ;; the SMIE code. | ||
| 101 | |||
| 102 | (defun smie-set-prec2tab (table x y val &optional override) | ||
| 103 | (assert (and x y)) | ||
| 104 | (let* ((key (cons x y)) | ||
| 105 | (old (gethash key table))) | ||
| 106 | (if (and old (not (eq old val))) | ||
| 107 | (if (and override (gethash key override)) | ||
| 108 | ;; FIXME: The override is meant to resolve ambiguities, | ||
| 109 | ;; but it also hides real conflicts. It would be great to | ||
| 110 | ;; be able to distinguish the two cases so that overrides | ||
| 111 | ;; don't hide real conflicts. | ||
| 112 | (puthash key (gethash key override) table) | ||
| 113 | (display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y))) | ||
| 114 | (puthash key val table)))) | ||
| 115 | |||
| 116 | (put 'smie-precs->prec2 'pure t) | ||
| 117 | (defun smie-precs->prec2 (precs) | ||
| 118 | "Compute a 2D precedence table from a list of precedences. | ||
| 119 | PRECS should be a list, sorted by precedence (e.g. \"+\" will | ||
| 120 | come before \"*\"), of elements of the form \(left OP ...) | ||
| 121 | or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in | ||
| 122 | one of those elements share the same precedence level and associativity." | ||
| 123 | (let ((prec2-table (make-hash-table :test 'equal))) | ||
| 124 | (dolist (prec precs) | ||
| 125 | (dolist (op (cdr prec)) | ||
| 126 | (let ((selfrule (cdr (assq (car prec) | ||
| 127 | '((left . >) (right . <) (assoc . =)))))) | ||
| 128 | (when selfrule | ||
| 129 | (dolist (other-op (cdr prec)) | ||
| 130 | (smie-set-prec2tab prec2-table op other-op selfrule)))) | ||
| 131 | (let ((op1 '<) (op2 '>)) | ||
| 132 | (dolist (other-prec precs) | ||
| 133 | (if (eq prec other-prec) | ||
| 134 | (setq op1 '> op2 '<) | ||
| 135 | (dolist (other-op (cdr other-prec)) | ||
| 136 | (smie-set-prec2tab prec2-table op other-op op2) | ||
| 137 | (smie-set-prec2tab prec2-table other-op op op1))))))) | ||
| 138 | prec2-table)) | ||
| 139 | |||
| 140 | (put 'smie-merge-prec2s 'pure t) | ||
| 141 | (defun smie-merge-prec2s (&rest tables) | ||
| 142 | (if (null (cdr tables)) | ||
| 143 | (car tables) | ||
| 144 | (let ((prec2 (make-hash-table :test 'equal))) | ||
| 145 | (dolist (table tables) | ||
| 146 | (maphash (lambda (k v) | ||
| 147 | (if (consp k) | ||
| 148 | (smie-set-prec2tab prec2 (car k) (cdr k) v) | ||
| 149 | (if (and (gethash k prec2) | ||
| 150 | (not (equal (gethash k prec2) v))) | ||
| 151 | (error "Conflicting values for %s property" k) | ||
| 152 | (puthash k v prec2)))) | ||
| 153 | table)) | ||
| 154 | prec2))) | ||
| 155 | |||
| 156 | (put 'smie-bnf->prec2 'pure t) | ||
| 157 | (defun smie-bnf->prec2 (bnf &rest precs) | ||
| 158 | (let ((nts (mapcar 'car bnf)) ;Non-terminals | ||
| 159 | (first-ops-table ()) | ||
| 160 | (last-ops-table ()) | ||
| 161 | (first-nts-table ()) | ||
| 162 | (last-nts-table ()) | ||
| 163 | (prec2 (make-hash-table :test 'equal)) | ||
| 164 | (override (apply 'smie-merge-prec2s | ||
| 165 | (mapcar 'smie-precs->prec2 precs))) | ||
| 166 | again) | ||
| 167 | (dolist (rules bnf) | ||
| 168 | (let ((nt (car rules)) | ||
| 169 | (last-ops ()) | ||
| 170 | (first-ops ()) | ||
| 171 | (last-nts ()) | ||
| 172 | (first-nts ())) | ||
| 173 | (dolist (rhs (cdr rules)) | ||
| 174 | (unless (consp rhs) | ||
| 175 | (signal 'wrong-type-argument `(consp ,rhs))) | ||
| 176 | (if (not (member (car rhs) nts)) | ||
| 177 | (pushnew (car rhs) first-ops) | ||
| 178 | (pushnew (car rhs) first-nts) | ||
| 179 | (when (consp (cdr rhs)) | ||
| 180 | ;; If the first is not an OP we add the second (which | ||
| 181 | ;; should be an OP if BNF is an "operator grammar"). | ||
| 182 | ;; Strictly speaking, this should only be done if the | ||
| 183 | ;; first is a non-terminal which can expand to a phrase | ||
| 184 | ;; without any OP in it, but checking doesn't seem worth | ||
| 185 | ;; the trouble, and it lets the writer of the BNF | ||
| 186 | ;; be a bit more sloppy by skipping uninteresting base | ||
| 187 | ;; cases which are terminals but not OPs. | ||
| 188 | (assert (not (member (cadr rhs) nts))) | ||
| 189 | (pushnew (cadr rhs) first-ops))) | ||
| 190 | (let ((shr (reverse rhs))) | ||
| 191 | (if (not (member (car shr) nts)) | ||
| 192 | (pushnew (car shr) last-ops) | ||
| 193 | (pushnew (car shr) last-nts) | ||
| 194 | (when (consp (cdr shr)) | ||
| 195 | (assert (not (member (cadr shr) nts))) | ||
| 196 | (pushnew (cadr shr) last-ops))))) | ||
| 197 | (push (cons nt first-ops) first-ops-table) | ||
| 198 | (push (cons nt last-ops) last-ops-table) | ||
| 199 | (push (cons nt first-nts) first-nts-table) | ||
| 200 | (push (cons nt last-nts) last-nts-table))) | ||
| 201 | ;; Compute all first-ops by propagating the initial ones we have | ||
| 202 | ;; now, according to first-nts. | ||
| 203 | (setq again t) | ||
| 204 | (while (prog1 again (setq again nil)) | ||
| 205 | (dolist (first-nts first-nts-table) | ||
| 206 | (let* ((nt (pop first-nts)) | ||
| 207 | (first-ops (assoc nt first-ops-table))) | ||
| 208 | (dolist (first-nt first-nts) | ||
| 209 | (dolist (op (cdr (assoc first-nt first-ops-table))) | ||
| 210 | (unless (member op first-ops) | ||
| 211 | (setq again t) | ||
| 212 | (push op (cdr first-ops)))))))) | ||
| 213 | ;; Same thing for last-ops. | ||
| 214 | (setq again t) | ||
| 215 | (while (prog1 again (setq again nil)) | ||
| 216 | (dolist (last-nts last-nts-table) | ||
| 217 | (let* ((nt (pop last-nts)) | ||
| 218 | (last-ops (assoc nt last-ops-table))) | ||
| 219 | (dolist (last-nt last-nts) | ||
| 220 | (dolist (op (cdr (assoc last-nt last-ops-table))) | ||
| 221 | (unless (member op last-ops) | ||
| 222 | (setq again t) | ||
| 223 | (push op (cdr last-ops)))))))) | ||
| 224 | ;; Now generate the 2D precedence table. | ||
| 225 | (dolist (rules bnf) | ||
| 226 | (dolist (rhs (cdr rules)) | ||
| 227 | (while (cdr rhs) | ||
| 228 | (cond | ||
| 229 | ((member (car rhs) nts) | ||
| 230 | (dolist (last (cdr (assoc (car rhs) last-ops-table))) | ||
| 231 | (smie-set-prec2tab prec2 last (cadr rhs) '> override))) | ||
| 232 | ((member (cadr rhs) nts) | ||
| 233 | (dolist (first (cdr (assoc (cadr rhs) first-ops-table))) | ||
| 234 | (smie-set-prec2tab prec2 (car rhs) first '< override)) | ||
| 235 | (if (and (cddr rhs) (not (member (car (cddr rhs)) nts))) | ||
| 236 | (smie-set-prec2tab prec2 (car rhs) (car (cddr rhs)) | ||
| 237 | '= override))) | ||
| 238 | (t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override))) | ||
| 239 | (setq rhs (cdr rhs))))) | ||
| 240 | ;; Keep track of which tokens are openers/closer, so they can get a nil | ||
| 241 | ;; precedence in smie-prec2->grammar. | ||
| 242 | (puthash :smie-open/close-alist (smie-bnf-classify bnf) prec2) | ||
| 243 | (puthash :smie-closer-alist (smie-bnf-closer-alist bnf) prec2) | ||
| 244 | prec2)) | ||
| 245 | |||
| 246 | ;; (defun smie-prec2-closer-alist (prec2 include-inners) | ||
| 247 | ;; "Build a closer-alist from a PREC2 table. | ||
| 248 | ;; The return value is in the same form as `smie-closer-alist'. | ||
| 249 | ;; INCLUDE-INNERS if non-nil means that inner keywords will be included | ||
| 250 | ;; in the table, e.g. the table will include things like (\"if\" . \"else\")." | ||
| 251 | ;; (let* ((non-openers '()) | ||
| 252 | ;; (non-closers '()) | ||
| 253 | ;; ;; For each keyword, this gives the matching openers, if any. | ||
| 254 | ;; (openers (make-hash-table :test 'equal)) | ||
| 255 | ;; (closers '()) | ||
| 256 | ;; (done nil)) | ||
| 257 | ;; ;; First, find the non-openers and non-closers. | ||
| 258 | ;; (maphash (lambda (k v) | ||
| 259 | ;; (unless (or (eq v '<) (member (cdr k) non-openers)) | ||
| 260 | ;; (push (cdr k) non-openers)) | ||
| 261 | ;; (unless (or (eq v '>) (member (car k) non-closers)) | ||
| 262 | ;; (push (car k) non-closers))) | ||
| 263 | ;; prec2) | ||
| 264 | ;; ;; Then find the openers and closers. | ||
| 265 | ;; (maphash (lambda (k _) | ||
| 266 | ;; (unless (member (car k) non-openers) | ||
| 267 | ;; (puthash (car k) (list (car k)) openers)) | ||
| 268 | ;; (unless (or (member (cdr k) non-closers) | ||
| 269 | ;; (member (cdr k) closers)) | ||
| 270 | ;; (push (cdr k) closers))) | ||
| 271 | ;; prec2) | ||
| 272 | ;; ;; Then collect the matching elements. | ||
| 273 | ;; (while (not done) | ||
| 274 | ;; (setq done t) | ||
| 275 | ;; (maphash (lambda (k v) | ||
| 276 | ;; (when (eq v '=) | ||
| 277 | ;; (let ((aopeners (gethash (car k) openers)) | ||
| 278 | ;; (dopeners (gethash (cdr k) openers)) | ||
| 279 | ;; (new nil)) | ||
| 280 | ;; (dolist (o aopeners) | ||
| 281 | ;; (unless (member o dopeners) | ||
| 282 | ;; (setq new t) | ||
| 283 | ;; (push o dopeners))) | ||
| 284 | ;; (when new | ||
| 285 | ;; (setq done nil) | ||
| 286 | ;; (puthash (cdr k) dopeners openers))))) | ||
| 287 | ;; prec2)) | ||
| 288 | ;; ;; Finally, dump the resulting table. | ||
| 289 | ;; (let ((alist '())) | ||
| 290 | ;; (maphash (lambda (k v) | ||
| 291 | ;; (when (or include-inners (member k closers)) | ||
| 292 | ;; (dolist (opener v) | ||
| 293 | ;; (unless (equal opener k) | ||
| 294 | ;; (push (cons opener k) alist))))) | ||
| 295 | ;; openers) | ||
| 296 | ;; alist))) | ||
| 297 | |||
| 298 | (defun smie-bnf-closer-alist (bnf &optional no-inners) | ||
| 299 | ;; We can also build this closer-alist table from a prec2 table, | ||
| 300 | ;; but it takes more work, and the order is unpredictable, which | ||
| 301 | ;; is a problem for smie-close-block. | ||
| 302 | ;; More convenient would be to build it from a levels table since we | ||
| 303 | ;; always have this table (contrary to the BNF), but it has all the | ||
| 304 | ;; disadvantages of the prec2 case plus the disadvantage that the levels | ||
| 305 | ;; table has lost some info which would result in extra invalid pairs. | ||
| 306 | "Build a closer-alist from a BNF table. | ||
| 307 | The return value is in the same form as `smie-closer-alist'. | ||
| 308 | NO-INNERS if non-nil means that inner keywords will be excluded | ||
| 309 | from the table, e.g. the table will not include things like (\"if\" . \"else\")." | ||
| 310 | (let ((nts (mapcar #'car bnf)) ;non terminals. | ||
| 311 | (alist '())) | ||
| 312 | (dolist (nt bnf) | ||
| 313 | (dolist (rhs (cdr nt)) | ||
| 314 | (unless (or (< (length rhs) 2) (member (car rhs) nts)) | ||
| 315 | (if no-inners | ||
| 316 | (let ((last (car (last rhs)))) | ||
| 317 | (unless (member last nts) | ||
| 318 | (pushnew (cons (car rhs) last) alist :test #'equal))) | ||
| 319 | ;; Reverse so that the "real" closer gets there first, | ||
| 320 | ;; which is important for smie-close-block. | ||
| 321 | (dolist (term (reverse (cdr rhs))) | ||
| 322 | (unless (member term nts) | ||
| 323 | (pushnew (cons (car rhs) term) alist :test #'equal))))))) | ||
| 324 | (nreverse alist))) | ||
| 325 | |||
| 326 | (defun smie-bnf-classify (bnf) | ||
| 327 | "Return a table classifying terminals. | ||
| 328 | Each terminal can either be an `opener', a `closer', or neither." | ||
| 329 | (let ((table (make-hash-table :test #'equal)) | ||
| 330 | (alist '())) | ||
| 331 | (dolist (category bnf) | ||
| 332 | (puthash (car category) 'neither table) ;Remove non-terminals. | ||
| 333 | (dolist (rhs (cdr category)) | ||
| 334 | (if (null (cdr rhs)) | ||
| 335 | (puthash (pop rhs) 'neither table) | ||
| 336 | (let ((first (pop rhs))) | ||
| 337 | (puthash first | ||
| 338 | (if (memq (gethash first table) '(nil opener)) | ||
| 339 | 'opener 'neither) | ||
| 340 | table)) | ||
| 341 | (while (cdr rhs) | ||
| 342 | (puthash (pop rhs) 'neither table)) ;Remove internals. | ||
| 343 | (let ((last (pop rhs))) | ||
| 344 | (puthash last | ||
| 345 | (if (memq (gethash last table) '(nil closer)) | ||
| 346 | 'closer 'neither) | ||
| 347 | table))))) | ||
| 348 | (maphash (lambda (tok v) | ||
| 349 | (when (memq v '(closer opener)) | ||
| 350 | (push (cons tok v) alist))) | ||
| 351 | table) | ||
| 352 | alist)) | ||
| 353 | |||
| 354 | (defun smie-debug--prec2-cycle (csts) | ||
| 355 | "Return a cycle in CSTS, assuming there's one. | ||
| 356 | CSTS is a list of pairs representing arcs in a graph." | ||
| 357 | ;; A PATH is of the form (START . REST) where REST is a reverse | ||
| 358 | ;; list of nodes through which the path goes. | ||
| 359 | (let ((paths (mapcar (lambda (pair) (list (car pair) (cdr pair))) csts)) | ||
| 360 | (cycle nil)) | ||
| 361 | (while (null cycle) | ||
| 362 | (dolist (path (prog1 paths (setq paths nil))) | ||
| 363 | (dolist (cst csts) | ||
| 364 | (when (eq (car cst) (nth 1 path)) | ||
| 365 | (if (eq (cdr cst) (car path)) | ||
| 366 | (setq cycle path) | ||
| 367 | (push (cons (car path) (cons (cdr cst) (cdr path))) | ||
| 368 | paths)))))) | ||
| 369 | (cons (car cycle) (nreverse (cdr cycle))))) | ||
| 370 | |||
| 371 | (defun smie-debug--describe-cycle (table cycle) | ||
| 372 | (let ((names | ||
| 373 | (mapcar (lambda (val) | ||
| 374 | (let ((res nil)) | ||
| 375 | (dolist (elem table) | ||
| 376 | (if (eq (cdr elem) val) | ||
| 377 | (push (concat "." (car elem)) res)) | ||
| 378 | (if (eq (cddr elem) val) | ||
| 379 | (push (concat (car elem) ".") res))) | ||
| 380 | (assert res) | ||
| 381 | res)) | ||
| 382 | cycle))) | ||
| 383 | (mapconcat | ||
| 384 | (lambda (elems) (mapconcat 'identity elems "=")) | ||
| 385 | (append names (list (car names))) | ||
| 386 | " < "))) | ||
| 387 | |||
| 388 | (put 'smie-prec2->grammar 'pure t) | ||
| 389 | (defun smie-prec2->grammar (prec2) | ||
| 390 | "Take a 2D precedence table and turn it into an alist of precedence levels. | ||
| 391 | PREC2 is a table as returned by `smie-precs->prec2' or | ||
| 392 | `smie-bnf->prec2'." | ||
| 393 | ;; For each operator, we create two "variables" (corresponding to | ||
| 394 | ;; the left and right precedence level), which are represented by | ||
| 395 | ;; cons cells. Those are the very cons cells that appear in the | ||
| 396 | ;; final `table'. The value of each "variable" is kept in the `car'. | ||
| 397 | (let ((table ()) | ||
| 398 | (csts ()) | ||
| 399 | (eqs ()) | ||
| 400 | tmp x y) | ||
| 401 | ;; From `prec2' we construct a list of constraints between | ||
| 402 | ;; variables (aka "precedence levels"). These can be either | ||
| 403 | ;; equality constraints (in `eqs') or `<' constraints (in `csts'). | ||
| 404 | (maphash (lambda (k v) | ||
| 405 | (when (consp k) | ||
| 406 | (if (setq tmp (assoc (car k) table)) | ||
| 407 | (setq x (cddr tmp)) | ||
| 408 | (setq x (cons nil nil)) | ||
| 409 | (push (cons (car k) (cons nil x)) table)) | ||
| 410 | (if (setq tmp (assoc (cdr k) table)) | ||
| 411 | (setq y (cdr tmp)) | ||
| 412 | (setq y (cons nil (cons nil nil))) | ||
| 413 | (push (cons (cdr k) y) table)) | ||
| 414 | (ecase v | ||
| 415 | (= (push (cons x y) eqs)) | ||
| 416 | (< (push (cons x y) csts)) | ||
| 417 | (> (push (cons y x) csts))))) | ||
| 418 | prec2) | ||
| 419 | ;; First process the equality constraints. | ||
| 420 | (let ((eqs eqs)) | ||
| 421 | (while eqs | ||
| 422 | (let ((from (caar eqs)) | ||
| 423 | (to (cdar eqs))) | ||
| 424 | (setq eqs (cdr eqs)) | ||
| 425 | (if (eq to from) | ||
| 426 | nil ;Nothing to do. | ||
| 427 | (dolist (other-eq eqs) | ||
| 428 | (if (eq from (cdr other-eq)) (setcdr other-eq to)) | ||
| 429 | (when (eq from (car other-eq)) | ||
| 430 | ;; This can happen because of `assoc' settings in precs | ||
| 431 | ;; or because of a rhs like ("op" foo "op"). | ||
| 432 | (setcar other-eq to))) | ||
| 433 | (dolist (cst csts) | ||
| 434 | (if (eq from (cdr cst)) (setcdr cst to)) | ||
| 435 | (if (eq from (car cst)) (setcar cst to))))))) | ||
| 436 | ;; Then eliminate trivial constraints iteratively. | ||
| 437 | (let ((i 0)) | ||
| 438 | (while csts | ||
| 439 | (let ((rhvs (mapcar 'cdr csts)) | ||
| 440 | (progress nil)) | ||
| 441 | (dolist (cst csts) | ||
| 442 | (unless (memq (car cst) rhvs) | ||
| 443 | (setq progress t) | ||
| 444 | ;; We could give each var in a given iteration the same value, | ||
| 445 | ;; but we can also give them arbitrarily different values. | ||
| 446 | ;; Basically, these are vars between which there is no | ||
| 447 | ;; constraint (neither equality nor inequality), so | ||
| 448 | ;; anything will do. | ||
| 449 | ;; We give them arbitrary values, which means that we | ||
| 450 | ;; replace the "no constraint" case with either > or < | ||
| 451 | ;; but not =. The reason we do that is so as to try and | ||
| 452 | ;; distinguish associative operators (which will have | ||
| 453 | ;; left = right). | ||
| 454 | (unless (caar cst) | ||
| 455 | (setcar (car cst) i) | ||
| 456 | (incf i)) | ||
| 457 | (setq csts (delq cst csts)))) | ||
| 458 | (unless progress | ||
| 459 | (error "Can't resolve the precedence cycle: %s" | ||
| 460 | (smie-debug--describe-cycle | ||
| 461 | table (smie-debug--prec2-cycle csts))))) | ||
| 462 | (incf i 10)) | ||
| 463 | ;; Propagate equalities back to their source. | ||
| 464 | (dolist (eq (nreverse eqs)) | ||
| 465 | (assert (or (null (caar eq)) (eq (car eq) (cdr eq)))) | ||
| 466 | (setcar (car eq) (cadr eq))) | ||
| 467 | ;; Finally, fill in the remaining vars (which only appeared on the | ||
| 468 | ;; right side of the < constraints). | ||
| 469 | (let ((classification-table (gethash :smie-open/close-alist prec2))) | ||
| 470 | (dolist (x table) | ||
| 471 | ;; When both sides are nil, it means this operator binds very | ||
| 472 | ;; very tight, but it's still just an operator, so we give it | ||
| 473 | ;; the highest precedence. | ||
| 474 | ;; OTOH if only one side is nil, it usually means it's like an | ||
| 475 | ;; open-paren, which is very important for indentation purposes, | ||
| 476 | ;; so we keep it nil if so, to make it easier to recognize. | ||
| 477 | (unless (or (nth 1 x) | ||
| 478 | (eq 'opener (cdr (assoc (car x) classification-table)))) | ||
| 479 | (setf (nth 1 x) i) | ||
| 480 | (incf i)) ;See other (incf i) above. | ||
| 481 | (unless (or (nth 2 x) | ||
| 482 | (eq 'closer (cdr (assoc (car x) classification-table)))) | ||
| 483 | (setf (nth 2 x) i) | ||
| 484 | (incf i))))) ;See other (incf i) above. | ||
| 485 | (let ((ca (gethash :smie-closer-alist prec2))) | ||
| 486 | (when ca (push (cons :smie-closer-alist ca) table))) | ||
| 487 | table)) | ||
| 488 | |||
| 489 | ;;; Parsing using a precedence level table. | ||
| 490 | |||
| 491 | (defvar smie-grammar 'unset | ||
| 492 | "List of token parsing info. | ||
| 493 | This list is normally built by `smie-prec2->grammar'. | ||
| 494 | Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL). | ||
| 495 | Parsing is done using an operator precedence parser. | ||
| 496 | LEFT-LEVEL and RIGHT-LEVEL can be either numbers or nil, where nil | ||
| 497 | means that this operator does not bind on the corresponding side, | ||
| 498 | i.e. a LEFT-LEVEL of nil means this is a token that behaves somewhat like | ||
| 499 | an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something | ||
| 500 | like a close-paren.") | ||
| 501 | |||
| 502 | (defvar smie-forward-token-function 'smie-default-forward-token | ||
| 503 | "Function to scan forward for the next token. | ||
| 504 | Called with no argument should return a token and move to its end. | ||
| 505 | If no token is found, return nil or the empty string. | ||
| 506 | It can return nil when bumping into a parenthesis, which lets SMIE | ||
| 507 | use syntax-tables to handle them in efficient C code.") | ||
| 508 | |||
| 509 | (defvar smie-backward-token-function 'smie-default-backward-token | ||
| 510 | "Function to scan backward the previous token. | ||
| 511 | Same calling convention as `smie-forward-token-function' except | ||
| 512 | it should move backward to the beginning of the previous token.") | ||
| 513 | |||
| 514 | (defalias 'smie-op-left 'car) | ||
| 515 | (defalias 'smie-op-right 'cadr) | ||
| 516 | |||
| 517 | (defun smie-default-backward-token () | ||
| 518 | (forward-comment (- (point))) | ||
| 519 | (buffer-substring-no-properties | ||
| 520 | (point) | ||
| 521 | (progn (if (zerop (skip-syntax-backward ".")) | ||
| 522 | (skip-syntax-backward "w_'")) | ||
| 523 | (point)))) | ||
| 524 | |||
| 525 | (defun smie-default-forward-token () | ||
| 526 | (forward-comment (point-max)) | ||
| 527 | (buffer-substring-no-properties | ||
| 528 | (point) | ||
| 529 | (progn (if (zerop (skip-syntax-forward ".")) | ||
| 530 | (skip-syntax-forward "w_'")) | ||
| 531 | (point)))) | ||
| 532 | |||
| 533 | (defun smie--associative-p (toklevels) | ||
| 534 | ;; in "a + b + c" we want to stop at each +, but in | ||
| 535 | ;; "if a then b elsif c then d else c" we don't want to stop at each keyword. | ||
| 536 | ;; To distinguish the two cases, we made smie-prec2->grammar choose | ||
| 537 | ;; different levels for each part of "if a then b else c", so that | ||
| 538 | ;; by checking if the left-level is equal to the right level, we can | ||
| 539 | ;; figure out that it's an associative operator. | ||
| 540 | ;; This is not 100% foolproof, tho, since the "elsif" will have to have | ||
| 541 | ;; equal left and right levels (since it's optional), so smie-next-sexp | ||
| 542 | ;; has to be careful to distinguish those different cases. | ||
| 543 | (eq (smie-op-left toklevels) (smie-op-right toklevels))) | ||
| 544 | |||
| 545 | (defun smie-next-sexp (next-token next-sexp op-forw op-back halfsexp) | ||
| 546 | "Skip over one sexp. | ||
| 547 | NEXT-TOKEN is a function of no argument that moves forward by one | ||
| 548 | token (after skipping comments if needed) and returns it. | ||
| 549 | NEXT-SEXP is a lower-level function to skip one sexp. | ||
| 550 | OP-FORW is the accessor to the forward level of the level data. | ||
| 551 | OP-BACK is the accessor to the backward level of the level data. | ||
| 552 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the | ||
| 553 | first token we see is an operator, skip over its left-hand-side argument. | ||
| 554 | Possible return values: | ||
| 555 | (FORW-LEVEL POS TOKEN): we couldn't skip TOKEN because its back-level | ||
| 556 | is too high. FORW-LEVEL is the forw-level of TOKEN, | ||
| 557 | POS is its start position in the buffer. | ||
| 558 | (t POS TOKEN): same thing when we bump on the wrong side of a paren. | ||
| 559 | (nil POS TOKEN): we skipped over a paren-like pair. | ||
| 560 | nil: we skipped over an identifier, matched parentheses, ..." | ||
| 561 | (catch 'return | ||
| 562 | (let ((levels ())) | ||
| 563 | (while | ||
| 564 | (let* ((pos (point)) | ||
| 565 | (token (funcall next-token)) | ||
| 566 | (toklevels (cdr (assoc token smie-grammar)))) | ||
| 567 | (cond | ||
| 568 | ((null toklevels) | ||
| 569 | (when (zerop (length token)) | ||
| 570 | (condition-case err | ||
| 571 | (progn (goto-char pos) (funcall next-sexp 1) nil) | ||
| 572 | (scan-error (throw 'return | ||
| 573 | (list t (caddr err) | ||
| 574 | (buffer-substring-no-properties | ||
| 575 | (caddr err) | ||
| 576 | (+ (caddr err) | ||
| 577 | (if (< (point) (caddr err)) | ||
| 578 | -1 1))))))) | ||
| 579 | (if (eq pos (point)) | ||
| 580 | ;; We did not move, so let's abort the loop. | ||
| 581 | (throw 'return (list t (point)))))) | ||
| 582 | ((null (funcall op-back toklevels)) | ||
| 583 | ;; A token like a paren-close. | ||
| 584 | (assert (funcall op-forw toklevels)) ;Otherwise, why mention it? | ||
| 585 | (push toklevels levels)) | ||
| 586 | (t | ||
| 587 | (while (and levels (< (funcall op-back toklevels) | ||
| 588 | (funcall op-forw (car levels)))) | ||
| 589 | (setq levels (cdr levels))) | ||
| 590 | (cond | ||
| 591 | ((null levels) | ||
| 592 | (if (and halfsexp (funcall op-forw toklevels)) | ||
| 593 | (push toklevels levels) | ||
| 594 | (throw 'return | ||
| 595 | (prog1 (list (or (car toklevels) t) (point) token) | ||
| 596 | (goto-char pos))))) | ||
| 597 | (t | ||
| 598 | (let ((lastlevels levels)) | ||
| 599 | (if (and levels (= (funcall op-back toklevels) | ||
| 600 | (funcall op-forw (car levels)))) | ||
| 601 | (setq levels (cdr levels))) | ||
| 602 | ;; We may have found a match for the previously pending | ||
| 603 | ;; operator. Is this the end? | ||
| 604 | (cond | ||
| 605 | ;; Keep looking as long as we haven't matched the | ||
| 606 | ;; topmost operator. | ||
| 607 | (levels | ||
| 608 | (if (funcall op-forw toklevels) | ||
| 609 | (push toklevels levels))) | ||
| 610 | ;; We matched the topmost operator. If the new operator | ||
| 611 | ;; is the last in the corresponding BNF rule, we're done. | ||
| 612 | ((null (funcall op-forw toklevels)) | ||
| 613 | ;; It is the last element, let's stop here. | ||
| 614 | (throw 'return (list nil (point) token))) | ||
| 615 | ;; If the new operator is not the last in the BNF rule, | ||
| 616 | ;; ans is not associative, it's one of the inner operators | ||
| 617 | ;; (like the "in" in "let .. in .. end"), so keep looking. | ||
| 618 | ((not (smie--associative-p toklevels)) | ||
| 619 | (push toklevels levels)) | ||
| 620 | ;; The new operator is associative. Two cases: | ||
| 621 | ;; - it's really just an associative operator (like + or ;) | ||
| 622 | ;; in which case we should have stopped right before. | ||
| 623 | ((and lastlevels | ||
| 624 | (smie--associative-p (car lastlevels))) | ||
| 625 | (throw 'return | ||
| 626 | (prog1 (list (or (car toklevels) t) (point) token) | ||
| 627 | (goto-char pos)))) | ||
| 628 | ;; - it's an associative operator within a larger construct | ||
| 629 | ;; (e.g. an "elsif"), so we should just ignore it and keep | ||
| 630 | ;; looking for the closing element. | ||
| 631 | (t (setq levels lastlevels)))))))) | ||
| 632 | levels) | ||
| 633 | (setq halfsexp nil))))) | ||
| 634 | |||
| 635 | (defun smie-backward-sexp (&optional halfsexp) | ||
| 636 | "Skip over one sexp. | ||
| 637 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the | ||
| 638 | first token we see is an operator, skip over its left-hand-side argument. | ||
| 639 | Possible return values: | ||
| 640 | (LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level | ||
| 641 | is too high. LEFT-LEVEL is the left-level of TOKEN, | ||
| 642 | POS is its start position in the buffer. | ||
| 643 | (t POS TOKEN): same thing but for an open-paren or the beginning of buffer. | ||
| 644 | (nil POS TOKEN): we skipped over a paren-like pair. | ||
| 645 | nil: we skipped over an identifier, matched parentheses, ..." | ||
| 646 | (smie-next-sexp | ||
| 647 | (indirect-function smie-backward-token-function) | ||
| 648 | (indirect-function 'backward-sexp) | ||
| 649 | (indirect-function 'smie-op-left) | ||
| 650 | (indirect-function 'smie-op-right) | ||
| 651 | halfsexp)) | ||
| 652 | |||
| 653 | (defun smie-forward-sexp (&optional halfsexp) | ||
| 654 | "Skip over one sexp. | ||
| 655 | HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the | ||
| 656 | first token we see is an operator, skip over its left-hand-side argument. | ||
| 657 | Possible return values: | ||
| 658 | (RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level | ||
| 659 | is too high. RIGHT-LEVEL is the right-level of TOKEN, | ||
| 660 | POS is its end position in the buffer. | ||
| 661 | (t POS TOKEN): same thing but for an open-paren or the beginning of buffer. | ||
| 662 | (nil POS TOKEN): we skipped over a paren-like pair. | ||
| 663 | nil: we skipped over an identifier, matched parentheses, ..." | ||
| 664 | (smie-next-sexp | ||
| 665 | (indirect-function smie-forward-token-function) | ||
| 666 | (indirect-function 'forward-sexp) | ||
| 667 | (indirect-function 'smie-op-right) | ||
| 668 | (indirect-function 'smie-op-left) | ||
| 669 | halfsexp)) | ||
| 670 | |||
| 671 | ;;; Miscellanous commands using the precedence parser. | ||
| 672 | |||
| 673 | (defun smie-backward-sexp-command (&optional n) | ||
| 674 | "Move backward through N logical elements." | ||
| 675 | (interactive "^p") | ||
| 676 | (smie-forward-sexp-command (- n))) | ||
| 677 | |||
| 678 | (defun smie-forward-sexp-command (&optional n) | ||
| 679 | "Move forward through N logical elements." | ||
| 680 | (interactive "^p") | ||
| 681 | (let ((forw (> n 0)) | ||
| 682 | (forward-sexp-function nil)) | ||
| 683 | (while (/= n 0) | ||
| 684 | (setq n (- n (if forw 1 -1))) | ||
| 685 | (let ((pos (point)) | ||
| 686 | (res (if forw | ||
| 687 | (smie-forward-sexp 'halfsexp) | ||
| 688 | (smie-backward-sexp 'halfsexp)))) | ||
| 689 | (if (and (car res) (= pos (point)) (not (if forw (eobp) (bobp)))) | ||
| 690 | (signal 'scan-error | ||
| 691 | (list "Containing expression ends prematurely" | ||
| 692 | (cadr res) (cadr res))) | ||
| 693 | nil))))) | ||
| 694 | |||
| 695 | (defvar smie-closer-alist nil | ||
| 696 | "Alist giving the closer corresponding to an opener.") | ||
| 697 | |||
| 698 | (defun smie-close-block () | ||
| 699 | "Close the closest surrounding block." | ||
| 700 | (interactive) | ||
| 701 | (let ((closer | ||
| 702 | (save-excursion | ||
| 703 | (backward-up-list 1) | ||
| 704 | (if (looking-at "\\s(") | ||
| 705 | (string (cdr (syntax-after (point)))) | ||
| 706 | (let* ((open (funcall smie-forward-token-function)) | ||
| 707 | (closer (cdr (assoc open smie-closer-alist))) | ||
| 708 | (levels (list (assoc open smie-grammar))) | ||
| 709 | (seen '()) | ||
| 710 | (found '())) | ||
| 711 | (cond | ||
| 712 | ;; Even if we improve the auto-computation of closers, | ||
| 713 | ;; there are still cases where we need manual | ||
| 714 | ;; intervention, e.g. for Octave's use of `until' | ||
| 715 | ;; as a pseudo-closer of `do'. | ||
| 716 | (closer) | ||
| 717 | ((or (equal levels '(nil)) (nth 1 (car levels))) | ||
| 718 | (error "Doesn't look like a block")) | ||
| 719 | (t | ||
| 720 | ;; Now that smie-setup automatically sets smie-closer-alist | ||
| 721 | ;; from the BNF, this is not really needed any more. | ||
| 722 | (while levels | ||
| 723 | (let ((level (pop levels))) | ||
| 724 | (dolist (other smie-grammar) | ||
| 725 | (when (and (eq (nth 2 level) (nth 1 other)) | ||
| 726 | (not (memq other seen))) | ||
| 727 | (push other seen) | ||
| 728 | (if (nth 2 other) | ||
| 729 | (push other levels) | ||
| 730 | (push (car other) found)))))) | ||
| 731 | (cond | ||
| 732 | ((null found) (error "No known closer for opener %s" open)) | ||
| 733 | ;; FIXME: what should we do if there are various closers? | ||
| 734 | (t (car found)))))))))) | ||
| 735 | (unless (save-excursion (skip-chars-backward " \t") (bolp)) | ||
| 736 | (newline)) | ||
| 737 | (insert closer) | ||
| 738 | (if (save-excursion (skip-chars-forward " \t") (eolp)) | ||
| 739 | (indent-according-to-mode) | ||
| 740 | (reindent-then-newline-and-indent)))) | ||
| 741 | |||
| 742 | (defun smie-down-list (&optional arg) | ||
| 743 | "Move forward down one level paren-like blocks. Like `down-list'. | ||
| 744 | With argument ARG, do this that many times. | ||
| 745 | A negative argument means move backward but still go down a level. | ||
| 746 | This command assumes point is not in a string or comment." | ||
| 747 | (interactive "p") | ||
| 748 | (let ((start (point)) | ||
| 749 | (inc (if (< arg 0) -1 1)) | ||
| 750 | (offset (if (< arg 0) 1 0)) | ||
| 751 | (next-token (if (< arg 0) | ||
| 752 | smie-backward-token-function | ||
| 753 | smie-forward-token-function))) | ||
| 754 | (while (/= arg 0) | ||
| 755 | (setq arg (- arg inc)) | ||
| 756 | (while | ||
| 757 | (let* ((pos (point)) | ||
| 758 | (token (funcall next-token)) | ||
| 759 | (levels (assoc token smie-grammar))) | ||
| 760 | (cond | ||
| 761 | ((zerop (length token)) | ||
| 762 | (if (if (< inc 0) (looking-back "\\s(\\|\\s)" (1- (point))) | ||
| 763 | (looking-at "\\s(\\|\\s)")) | ||
| 764 | ;; Go back to `start' in case of an error. This presumes | ||
| 765 | ;; none of the token we've found until now include a ( or ). | ||
| 766 | (progn (goto-char start) (down-list inc) nil) | ||
| 767 | (forward-sexp inc) | ||
| 768 | (/= (point) pos))) | ||
| 769 | ((and levels (null (nth (+ 1 offset) levels))) nil) | ||
| 770 | ((and levels (null (nth (- 2 offset) levels))) | ||
| 771 | (let ((end (point))) | ||
| 772 | (goto-char start) | ||
| 773 | (signal 'scan-error | ||
| 774 | (list "Containing expression ends prematurely" | ||
| 775 | pos end)))) | ||
| 776 | (t))))))) | ||
| 777 | |||
| 778 | (defvar smie-blink-matching-triggers '(?\s ?\n) | ||
| 779 | "Chars which might trigger `blink-matching-open'. | ||
| 780 | These can include the final chars of end-tokens, or chars that are | ||
| 781 | typically inserted right after an end token. | ||
| 782 | I.e. a good choice can be: | ||
| 783 | (delete-dups | ||
| 784 | (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw))))) | ||
| 785 | smie-closer-alist))") | ||
| 786 | |||
| 787 | (defcustom smie-blink-matching-inners t | ||
| 788 | "Whether SMIE should blink to matching opener for inner keywords. | ||
| 789 | If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"." | ||
| 790 | :type 'boolean | ||
| 791 | :group 'smie) | ||
| 792 | |||
| 793 | (defun smie-blink-matching-check (start end) | ||
| 794 | (save-excursion | ||
| 795 | (goto-char end) | ||
| 796 | (let ((ender (funcall smie-backward-token-function))) | ||
| 797 | (cond | ||
| 798 | ((not (and ender (rassoc ender smie-closer-alist))) | ||
| 799 | ;; This not is one of the begin..end we know how to check. | ||
| 800 | (blink-matching-check-mismatch start end)) | ||
| 801 | ((not start) t) | ||
| 802 | ((eq t (car (rassoc ender smie-closer-alist))) nil) | ||
| 803 | (t | ||
| 804 | (goto-char start) | ||
| 805 | (let ((starter (funcall smie-forward-token-function))) | ||
| 806 | (not (member (cons starter ender) smie-closer-alist)))))))) | ||
| 807 | |||
| 808 | (defun smie-blink-matching-open () | ||
| 809 | "Blink the matching opener when applicable. | ||
| 810 | This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'." | ||
| 811 | (let ((pos (point)) ;Position after the close token. | ||
| 812 | token) | ||
| 813 | (when (and blink-matching-paren | ||
| 814 | smie-closer-alist ; Optimization. | ||
| 815 | (or (eq (char-before) last-command-event) ;; Sanity check. | ||
| 816 | (save-excursion | ||
| 817 | (or (progn (skip-chars-backward " \t") | ||
| 818 | (setq pos (point)) | ||
| 819 | (eq (char-before) last-command-event)) | ||
| 820 | (progn (skip-chars-backward " \n\t") | ||
| 821 | (setq pos (point)) | ||
| 822 | (eq (char-before) last-command-event))))) | ||
| 823 | (memq last-command-event smie-blink-matching-triggers) | ||
| 824 | (not (nth 8 (syntax-ppss)))) | ||
| 825 | (save-excursion | ||
| 826 | (setq token (funcall smie-backward-token-function)) | ||
| 827 | (when (and (eq (point) (1- pos)) | ||
| 828 | (= 1 (length token)) | ||
| 829 | (not (rassoc token smie-closer-alist))) | ||
| 830 | ;; The trigger char is itself a token but is not one of the | ||
| 831 | ;; closers (e.g. ?\; in Octave mode), so go back to the | ||
| 832 | ;; previous token. | ||
| 833 | (setq pos (point)) | ||
| 834 | (setq token (funcall smie-backward-token-function))) | ||
| 835 | (when (rassoc token smie-closer-alist) | ||
| 836 | ;; We're after a close token. Let's still make sure we | ||
| 837 | ;; didn't skip a comment to find that token. | ||
| 838 | (funcall smie-forward-token-function) | ||
| 839 | (when (and (save-excursion | ||
| 840 | ;; Skip the trigger char, if applicable. | ||
| 841 | (if (eq (char-after) last-command-event) | ||
| 842 | (forward-char 1)) | ||
| 843 | (if (eq ?\n last-command-event) | ||
| 844 | ;; Skip any auto-indentation, if applicable. | ||
| 845 | (skip-chars-forward " \t")) | ||
| 846 | (>= (point) pos)) | ||
| 847 | ;; If token ends with a trigger char, don't blink for | ||
| 848 | ;; anything else than this trigger char, lest we'd blink | ||
| 849 | ;; both when inserting the trigger char and when | ||
| 850 | ;; inserting a subsequent trigger char like SPC. | ||
| 851 | (or (eq (point) pos) | ||
| 852 | (not (memq (char-before) | ||
| 853 | smie-blink-matching-triggers))) | ||
| 854 | (or smie-blink-matching-inners | ||
| 855 | (null (nth 2 (assoc token smie-grammar))))) | ||
| 856 | ;; The major mode might set blink-matching-check-function | ||
| 857 | ;; buffer-locally so that interactive calls to | ||
| 858 | ;; blink-matching-open work right, but let's not presume | ||
| 859 | ;; that's the case. | ||
| 860 | (let ((blink-matching-check-function #'smie-blink-matching-check)) | ||
| 861 | (blink-matching-open)))))))) | ||
| 862 | |||
| 863 | ;;; The indentation engine. | ||
| 864 | |||
| 865 | (defcustom smie-indent-basic 4 | ||
| 866 | "Basic amount of indentation." | ||
| 867 | :type 'integer | ||
| 868 | :group 'smie) | ||
| 869 | |||
| 870 | (defvar smie-rules-function 'ignore | ||
| 871 | "Function providing the indentation rules. | ||
| 872 | It takes two arguments METHOD and ARG where the meaning of ARG | ||
| 873 | and the expected return value depends on METHOD. | ||
| 874 | METHOD can be: | ||
| 875 | - :after, in which case ARG is a token and the function should return the | ||
| 876 | OFFSET to use for indentation after ARG. | ||
| 877 | - :before, in which case ARG is a token and the function should return the | ||
| 878 | OFFSET to use to indent ARG itself. | ||
| 879 | - :elem, in which case the function should return either: | ||
| 880 | - the offset to use to indent function arguments (ARG = `arg') | ||
| 881 | - the basic indentation step (ARG = `basic'). | ||
| 882 | - :list-intro, in which case ARG is a token and the function should return | ||
| 883 | non-nil if TOKEN is followed by a list of expressions (not separated by any | ||
| 884 | token) rather than an expression. | ||
| 885 | |||
| 886 | When ARG is a token, the function is called with point just before that token. | ||
| 887 | A return value of nil always means to fallback on the default behavior, so the | ||
| 888 | function should return nil for arguments it does not expect. | ||
| 889 | |||
| 890 | OFFSET can be: | ||
| 891 | nil use the default indentation rule. | ||
| 892 | `(column . COLUMN) indent to column COLUMN. | ||
| 893 | NUMBER offset by NUMBER, relative to a base token | ||
| 894 | which is the current token for :after and | ||
| 895 | its parent for :before. | ||
| 896 | |||
| 897 | The functions whose name starts with \"smie-rule-\" are helper functions | ||
| 898 | designed specifically for use in this function.") | ||
| 899 | |||
| 900 | (defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) | ||
| 901 | (defun smie-indent--hanging-p () | ||
| 902 | "Return non-nil if the current token is \"hanging\". | ||
| 903 | A hanging keyword is one that's at the end of a line except it's not at | ||
| 904 | the beginning of a line." | ||
| 905 | (and (not (smie-indent--bolp)) | ||
| 906 | (save-excursion | ||
| 907 | (<= (line-end-position) | ||
| 908 | (progn | ||
| 909 | (when (zerop (length (funcall smie-forward-token-function))) | ||
| 910 | ;; Could be an open-paren. | ||
| 911 | (forward-char 1)) | ||
| 912 | (skip-chars-forward " \t") | ||
| 913 | (or (eolp) | ||
| 914 | (and (looking-at comment-start-skip) | ||
| 915 | (forward-comment (point-max)))) | ||
| 916 | (point)))))) | ||
| 917 | |||
| 918 | (defalias 'smie-rule-bolp 'smie-indent--bolp) | ||
| 919 | (defun smie-indent--bolp () | ||
| 920 | "Return non-nil if the current token is the first on the line." | ||
| 921 | (save-excursion (skip-chars-backward " \t") (bolp))) | ||
| 922 | |||
| 923 | ;; Dynamically scoped. | ||
| 924 | (defvar smie--parent) (defvar smie--after) (defvar smie--token) | ||
| 925 | |||
| 926 | (defun smie-indent--parent () | ||
| 927 | (or smie--parent | ||
| 928 | (save-excursion | ||
| 929 | (let* ((pos (point)) | ||
| 930 | (tok (funcall smie-forward-token-function))) | ||
| 931 | (unless (cadr (assoc tok smie-grammar)) | ||
| 932 | (goto-char pos)) | ||
| 933 | (setq smie--parent | ||
| 934 | (smie-backward-sexp 'halfsexp)))))) | ||
| 935 | |||
| 936 | (defun smie-rule-parent-p (&rest parents) | ||
| 937 | "Return non-nil if the current token's parent is among PARENTS. | ||
| 938 | Only meaningful when called from within `smie-rules-function'." | ||
| 939 | (member (nth 2 (smie-indent--parent)) parents)) | ||
| 940 | |||
| 941 | (defun smie-rule-next-p (&rest tokens) | ||
| 942 | "Return non-nil if the next token is among TOKENS. | ||
| 943 | Only meaningful when called from within `smie-rules-function'." | ||
| 944 | (let ((next | ||
| 945 | (save-excursion | ||
| 946 | (unless smie--after | ||
| 947 | (smie-indent-forward-token) (setq smie--after (point))) | ||
| 948 | (goto-char smie--after) | ||
| 949 | (smie-indent-forward-token)))) | ||
| 950 | (member (car next) tokens))) | ||
| 951 | |||
| 952 | (defun smie-rule-prev-p (&rest tokens) | ||
| 953 | "Return non-nil if the previous token is among TOKENS." | ||
| 954 | (let ((prev (save-excursion | ||
| 955 | (smie-indent-backward-token)))) | ||
| 956 | (member (car prev) tokens))) | ||
| 957 | |||
| 958 | (defun smie-rule-sibling-p () | ||
| 959 | "Return non-nil if the parent is actually a sibling. | ||
| 960 | Only meaningful when called from within `smie-rules-function'." | ||
| 961 | (eq (car (smie-indent--parent)) | ||
| 962 | (cadr (assoc smie--token smie-grammar)))) | ||
| 963 | |||
| 964 | (defun smie-rule-parent (&optional offset) | ||
| 965 | "Align with parent. | ||
| 966 | If non-nil, OFFSET should be an integer giving an additional offset to apply. | ||
| 967 | Only meaningful when called from within `smie-rules-function'." | ||
| 968 | (save-excursion | ||
| 969 | (goto-char (cadr (smie-indent--parent))) | ||
| 970 | (cons 'column | ||
| 971 | (+ (or offset 0) | ||
| 972 | (if (smie-indent--hanging-p) | ||
| 973 | (smie-indent-virtual) (current-column)))))) | ||
| 974 | |||
| 975 | (defvar smie-rule-separator-outdent 2) | ||
| 976 | |||
| 977 | (defun smie-indent--separator-outdent () | ||
| 978 | ;; FIXME: Here we actually have several reasonable behaviors. | ||
| 979 | ;; E.g. for a parent token of "FOO" and a separator ";" we may want to: | ||
| 980 | ;; 1- left-align ; with FOO. | ||
| 981 | ;; 2- right-align ; with FOO. | ||
| 982 | ;; 3- align content after ; with content after FOO. | ||
| 983 | ;; 4- align content plus add/remove spaces so as to align ; with FOO. | ||
| 984 | ;; Currently, we try to align the contents (option 3) which actually behaves | ||
| 985 | ;; just like option 2 (if the number of spaces after FOO and ; is equal). | ||
| 986 | (let ((afterpos (save-excursion | ||
| 987 | (let ((tok (funcall smie-forward-token-function))) | ||
| 988 | (unless tok | ||
| 989 | (with-demoted-errors | ||
| 990 | (error "smie-rule-separator: can't skip token %s" | ||
| 991 | smie--token)))) | ||
| 992 | (skip-chars-forward " ") | ||
| 993 | (unless (eolp) (point))))) | ||
| 994 | (or (and afterpos | ||
| 995 | ;; This should always be true, unless | ||
| 996 | ;; smie-forward-token-function skipped a \n. | ||
| 997 | (< afterpos (line-end-position)) | ||
| 998 | (- afterpos (point))) | ||
| 999 | smie-rule-separator-outdent))) | ||
| 1000 | |||
| 1001 | (defun smie-rule-separator (method) | ||
| 1002 | "Indent current token as a \"separator\". | ||
| 1003 | By \"separator\", we mean here a token whose sole purpose is to separate | ||
| 1004 | various elements within some enclosing syntactic construct, and which does | ||
| 1005 | not have any semantic significance in itself (i.e. it would typically no exist | ||
| 1006 | as a node in an abstract syntax tree). | ||
| 1007 | Such a token is expected to have an associative syntax and be closely tied | ||
| 1008 | to its syntactic parent. Typical examples are \",\" in lists of arguments | ||
| 1009 | \(enclosed inside parentheses), or \";\" in sequences of instructions (enclosed | ||
| 1010 | in a {..} or begin..end block). | ||
| 1011 | METHOD should be the method name that was passed to `smie-rules-function'. | ||
| 1012 | Only meaningful when called from within `smie-rules-function'." | ||
| 1013 | ;; FIXME: The code below works OK for cases where the separators | ||
| 1014 | ;; are placed consistently always at beginning or always at the end, | ||
| 1015 | ;; but not if some are at the beginning and others are at the end. | ||
| 1016 | ;; I.e. it gets confused in cases such as: | ||
| 1017 | ;; ( a | ||
| 1018 | ;; , a, | ||
| 1019 | ;; b | ||
| 1020 | ;; , c, | ||
| 1021 | ;; d | ||
| 1022 | ;; ) | ||
| 1023 | ;; | ||
| 1024 | ;; Assuming token is associative, the default rule for associative | ||
| 1025 | ;; tokens (which assumes an infix operator) works fine for many cases. | ||
| 1026 | ;; We mostly need to take care of the case where token is at beginning of | ||
| 1027 | ;; line, in which case we want to align it with its enclosing parent. | ||
| 1028 | (cond | ||
| 1029 | ((and (eq method :before) (smie-rule-bolp) (not (smie-rule-sibling-p))) | ||
| 1030 | ;; FIXME: Rather than consult the number of spaces, we could *set* the | ||
| 1031 | ;; number of spaces so as to align the separator with the close-paren | ||
| 1032 | ;; while aligning the content with the rest. | ||
| 1033 | (let ((parent-col | ||
| 1034 | (save-excursion | ||
| 1035 | (goto-char (cadr smie--parent)) | ||
| 1036 | (if (smie-indent--hanging-p) | ||
| 1037 | (smie-indent-virtual) (current-column)))) | ||
| 1038 | (parent-pos-col ;FIXME: we knew this when computing smie--parent. | ||
| 1039 | (save-excursion | ||
| 1040 | (goto-char (cadr smie--parent)) | ||
| 1041 | (smie-indent-forward-token) | ||
| 1042 | (forward-comment (point-max)) | ||
| 1043 | (current-column)))) | ||
| 1044 | (cons 'column | ||
| 1045 | (max parent-col | ||
| 1046 | (min parent-pos-col | ||
| 1047 | (- parent-pos-col (smie-indent--separator-outdent))))))) | ||
| 1048 | ((and (eq method :after) (smie-indent--bolp)) | ||
| 1049 | (smie-indent--separator-outdent)))) | ||
| 1050 | |||
| 1051 | (defun smie-indent--offset (elem) | ||
| 1052 | (or (funcall smie-rules-function :elem elem) | ||
| 1053 | (if (not (eq elem 'basic)) | ||
| 1054 | (funcall smie-rules-function :elem 'basic)) | ||
| 1055 | smie-indent-basic)) | ||
| 1056 | |||
| 1057 | (defun smie-indent--rule (method token | ||
| 1058 | ;; FIXME: Too many parameters. | ||
| 1059 | &optional after parent base-pos) | ||
| 1060 | "Compute indentation column according to `indent-rule-functions'. | ||
| 1061 | METHOD and TOKEN are passed to `indent-rule-functions'. | ||
| 1062 | AFTER is the position after TOKEN, if known. | ||
| 1063 | PARENT is the parent info returned by `smie-backward-sexp', if known. | ||
| 1064 | BASE-POS is the position relative to which offsets should be applied." | ||
| 1065 | ;; This is currently called in 3 cases: | ||
| 1066 | ;; - :before opener, where rest=nil but base-pos could as well be parent. | ||
| 1067 | ;; - :before other, where | ||
| 1068 | ;; ; after=nil | ||
| 1069 | ;; ; parent is set | ||
| 1070 | ;; ; base-pos=parent | ||
| 1071 | ;; - :after tok, where | ||
| 1072 | ;; ; after is set; parent=nil; base-pos=point; | ||
| 1073 | (save-excursion | ||
| 1074 | (let ((offset | ||
| 1075 | (let ((smie--parent parent) | ||
| 1076 | (smie--token token) | ||
| 1077 | (smie--after after)) | ||
| 1078 | (funcall smie-rules-function method token)))) | ||
| 1079 | (cond | ||
| 1080 | ((not offset) nil) | ||
| 1081 | ((eq (car-safe offset) 'column) (cdr offset)) | ||
| 1082 | ((integerp offset) | ||
| 1083 | (+ offset | ||
| 1084 | (if (null base-pos) 0 | ||
| 1085 | (goto-char base-pos) | ||
| 1086 | (if (smie-indent--hanging-p) | ||
| 1087 | (smie-indent-virtual) (current-column))))) | ||
| 1088 | (t (error "Unknown indentation offset %s" offset)))))) | ||
| 1089 | |||
| 1090 | (defun smie-indent-forward-token () | ||
| 1091 | "Skip token forward and return it, along with its levels." | ||
| 1092 | (let ((tok (funcall smie-forward-token-function))) | ||
| 1093 | (cond | ||
| 1094 | ((< 0 (length tok)) (assoc tok smie-grammar)) | ||
| 1095 | ((looking-at "\\s(\\|\\s)\\(\\)") | ||
| 1096 | (forward-char 1) | ||
| 1097 | (cons (buffer-substring (1- (point)) (point)) | ||
| 1098 | (if (match-end 1) '(0 nil) '(nil 0))))))) | ||
| 1099 | |||
| 1100 | (defun smie-indent-backward-token () | ||
| 1101 | "Skip token backward and return it, along with its levels." | ||
| 1102 | (let ((tok (funcall smie-backward-token-function)) | ||
| 1103 | class) | ||
| 1104 | (cond | ||
| 1105 | ((< 0 (length tok)) (assoc tok smie-grammar)) | ||
| 1106 | ;; 4 == open paren syntax, 5 == close. | ||
| 1107 | ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5)) | ||
| 1108 | (forward-char -1) | ||
| 1109 | (cons (buffer-substring (point) (1+ (point))) | ||
| 1110 | (if (eq class 4) '(nil 0) '(0 nil))))))) | ||
| 1111 | |||
| 1112 | (defun smie-indent-virtual () | ||
| 1113 | ;; We used to take an optional arg (with value :not-hanging) to specify that | ||
| 1114 | ;; we should only use (smie-indent-calculate) if we're looking at a hanging | ||
| 1115 | ;; keyword. This was a bad idea, because the virtual indent of a position | ||
| 1116 | ;; should not depend on the caller, since it leads to situations where two | ||
| 1117 | ;; dependent indentations get indented differently. | ||
| 1118 | "Compute the virtual indentation to use for point. | ||
| 1119 | This is used when we're not trying to indent point but just | ||
| 1120 | need to compute the column at which point should be indented | ||
| 1121 | in order to figure out the indentation of some other (further down) point." | ||
| 1122 | ;; Trust pre-existing indentation on other lines. | ||
| 1123 | (if (smie-indent--bolp) (current-column) (smie-indent-calculate))) | ||
| 1124 | |||
| 1125 | (defun smie-indent-fixindent () | ||
| 1126 | ;; Obey the `fixindent' special comment. | ||
| 1127 | (and (smie-indent--bolp) | ||
| 1128 | (save-excursion | ||
| 1129 | (comment-normalize-vars) | ||
| 1130 | (re-search-forward (concat comment-start-skip | ||
| 1131 | "fixindent" | ||
| 1132 | comment-end-skip) | ||
| 1133 | ;; 1+ to account for the \n comment termination. | ||
| 1134 | (1+ (line-end-position)) t)) | ||
| 1135 | (current-column))) | ||
| 1136 | |||
| 1137 | (defun smie-indent-bob () | ||
| 1138 | ;; Start the file at column 0. | ||
| 1139 | (save-excursion | ||
| 1140 | (forward-comment (- (point))) | ||
| 1141 | (if (bobp) 0))) | ||
| 1142 | |||
| 1143 | (defun smie-indent-close () | ||
| 1144 | ;; Align close paren with opening paren. | ||
| 1145 | (save-excursion | ||
| 1146 | ;; (forward-comment (point-max)) | ||
| 1147 | (when (looking-at "\\s)") | ||
| 1148 | (while (not (zerop (skip-syntax-forward ")"))) | ||
| 1149 | (skip-chars-forward " \t")) | ||
| 1150 | (condition-case nil | ||
| 1151 | (progn | ||
| 1152 | (backward-sexp 1) | ||
| 1153 | (smie-indent-virtual)) ;:not-hanging | ||
| 1154 | (scan-error nil))))) | ||
| 1155 | |||
| 1156 | (defun smie-indent-keyword () | ||
| 1157 | ;; Align closing token with the corresponding opening one. | ||
| 1158 | ;; (e.g. "of" with "case", or "in" with "let"). | ||
| 1159 | (save-excursion | ||
| 1160 | (let* ((pos (point)) | ||
| 1161 | (toklevels (smie-indent-forward-token)) | ||
| 1162 | (token (pop toklevels))) | ||
| 1163 | (if (null (car toklevels)) | ||
| 1164 | (save-excursion | ||
| 1165 | (goto-char pos) | ||
| 1166 | ;; Different cases: | ||
| 1167 | ;; - smie-indent--bolp: "indent according to others". | ||
| 1168 | ;; - common hanging: "indent according to others". | ||
| 1169 | ;; - SML-let hanging: "indent like parent". | ||
| 1170 | ;; - if-after-else: "indent-like parent". | ||
| 1171 | ;; - middle-of-line: "trust current position". | ||
| 1172 | (cond | ||
| 1173 | ((null (cdr toklevels)) nil) ;Not a keyword. | ||
| 1174 | ((smie-indent--bolp) | ||
| 1175 | ;; For an open-paren-like thingy at BOL, always indent only | ||
| 1176 | ;; based on other rules (typically smie-indent-after-keyword). | ||
| 1177 | nil) | ||
| 1178 | ;; We're only ever here for virtual-indent. | ||
| 1179 | ((smie-indent--rule :before token)) | ||
| 1180 | (t | ||
| 1181 | ;; By default use point unless we're hanging. | ||
| 1182 | (unless (smie-indent--hanging-p) (current-column))))) | ||
| 1183 | |||
| 1184 | ;; FIXME: This still looks too much like black magic!! | ||
| 1185 | (let* ((parent (smie-backward-sexp 'halfsexp))) | ||
| 1186 | ;; Different behaviors: | ||
| 1187 | ;; - align with parent. | ||
| 1188 | ;; - parent + offset. | ||
| 1189 | ;; - after parent's column + offset (actually, after or before | ||
| 1190 | ;; depending on where backward-sexp stopped). | ||
| 1191 | ;; ? let it drop to some other indentation function (almost never). | ||
| 1192 | ;; ? parent + offset + parent's own offset. | ||
| 1193 | ;; Different cases: | ||
| 1194 | ;; - bump into a same-level operator. | ||
| 1195 | ;; - bump into a specific known parent. | ||
| 1196 | ;; - find a matching open-paren thingy. | ||
| 1197 | ;; - bump into some random parent. | ||
| 1198 | ;; ? borderline case (almost never). | ||
| 1199 | ;; ? bump immediately into a parent. | ||
| 1200 | (cond | ||
| 1201 | ((not (or (< (point) pos) | ||
| 1202 | (and (cadr parent) (< (cadr parent) pos)))) | ||
| 1203 | ;; If we didn't move at all, that means we didn't really skip | ||
| 1204 | ;; what we wanted. Should almost never happen, other than | ||
| 1205 | ;; maybe when an infix or close-paren is at the beginning | ||
| 1206 | ;; of a buffer. | ||
| 1207 | nil) | ||
| 1208 | ((save-excursion | ||
| 1209 | (goto-char pos) | ||
| 1210 | (smie-indent--rule :before token nil parent (cadr parent)))) | ||
| 1211 | ((eq (car parent) (car toklevels)) | ||
| 1212 | ;; We bumped into a same-level operator; align with it. | ||
| 1213 | (if (and (smie-indent--bolp) (/= (point) pos) | ||
| 1214 | (save-excursion | ||
| 1215 | (goto-char (goto-char (cadr parent))) | ||
| 1216 | (not (smie-indent--bolp)))) | ||
| 1217 | ;; If the parent is at EOL and its children are indented like | ||
| 1218 | ;; itself, then we can just obey the indentation chosen for the | ||
| 1219 | ;; child. | ||
| 1220 | ;; This is important for operators like ";" which | ||
| 1221 | ;; are usually at EOL (and have an offset of 0): otherwise we'd | ||
| 1222 | ;; always go back over all the statements, which is | ||
| 1223 | ;; a performance problem and would also mean that fixindents | ||
| 1224 | ;; in the middle of such a sequence would be ignored. | ||
| 1225 | ;; | ||
| 1226 | ;; This is a delicate point! | ||
| 1227 | ;; Even if the offset is not 0, we could follow the same logic | ||
| 1228 | ;; and subtract the offset from the child's indentation. | ||
| 1229 | ;; But that would more often be a bad idea: OT1H we generally | ||
| 1230 | ;; want to reuse the closest similar indentation point, so that | ||
| 1231 | ;; the user's choice (or the fixindents) are obeyed. But OTOH | ||
| 1232 | ;; we don't want this to affect "unrelated" parts of the code. | ||
| 1233 | ;; E.g. a fixindent in the body of a "begin..end" should not | ||
| 1234 | ;; affect the indentation of the "end". | ||
| 1235 | (current-column) | ||
| 1236 | (goto-char (cadr parent)) | ||
| 1237 | ;; Don't use (smie-indent-virtual :not-hanging) here, because we | ||
| 1238 | ;; want to jump back over a sequence of same-level ops such as | ||
| 1239 | ;; a -> b -> c | ||
| 1240 | ;; -> d | ||
| 1241 | ;; So as to align with the earliest appropriate place. | ||
| 1242 | (smie-indent-virtual))) | ||
| 1243 | (t | ||
| 1244 | (if (and (= (point) pos) (smie-indent--bolp)) | ||
| 1245 | ;; Since we started at BOL, we're not computing a virtual | ||
| 1246 | ;; indentation, and we're still at the starting point, so | ||
| 1247 | ;; we can't use `current-column' which would cause | ||
| 1248 | ;; indentation to depend on itself and we can't use | ||
| 1249 | ;; smie-indent-virtual since that would be an inf-loop. | ||
| 1250 | nil | ||
| 1251 | ;; In indent-keyword, if we're indenting `then' wrt `if', we | ||
| 1252 | ;; want to use indent-virtual rather than use just | ||
| 1253 | ;; current-column, so that we can apply the (:before . "if") | ||
| 1254 | ;; rule which does the "else if" dance in SML. But in other | ||
| 1255 | ;; cases, we do not want to use indent-virtual (e.g. indentation | ||
| 1256 | ;; of "*" w.r.t "+", or ";" wrt "("). We could just always use | ||
| 1257 | ;; indent-virtual and then have indent-rules say explicitly to | ||
| 1258 | ;; use `point' after things like "(" or "+" when they're not at | ||
| 1259 | ;; EOL, but you'd end up with lots of those rules. | ||
| 1260 | ;; So we use a heuristic here, which is that we only use virtual | ||
| 1261 | ;; if the parent is tightly linked to the child token (they're | ||
| 1262 | ;; part of the same BNF rule). | ||
| 1263 | (if (car parent) (current-column) (smie-indent-virtual)))))))))) | ||
| 1264 | |||
| 1265 | (defun smie-indent-comment () | ||
| 1266 | "Compute indentation of a comment." | ||
| 1267 | ;; Don't do it for virtual indentations. We should normally never be "in | ||
| 1268 | ;; front of a comment" when doing virtual-indentation anyway. And if we are | ||
| 1269 | ;; (as can happen in octave-mode), moving forward can lead to inf-loops. | ||
| 1270 | (and (smie-indent--bolp) | ||
| 1271 | (let ((pos (point))) | ||
| 1272 | (save-excursion | ||
| 1273 | (beginning-of-line) | ||
| 1274 | (and (re-search-forward comment-start-skip (line-end-position) t) | ||
| 1275 | (eq pos (or (match-end 1) (match-beginning 0)))))) | ||
| 1276 | (save-excursion | ||
| 1277 | (forward-comment (point-max)) | ||
| 1278 | (skip-chars-forward " \t\r\n") | ||
| 1279 | (smie-indent-calculate)))) | ||
| 1280 | |||
| 1281 | (defun smie-indent-comment-continue () | ||
| 1282 | ;; indentation of comment-continue lines. | ||
| 1283 | (let ((continue (and comment-continue | ||
| 1284 | (comment-string-strip comment-continue t t)))) | ||
| 1285 | (and (< 0 (length continue)) | ||
| 1286 | (looking-at (regexp-quote continue)) (nth 4 (syntax-ppss)) | ||
| 1287 | (let ((ppss (syntax-ppss))) | ||
| 1288 | (save-excursion | ||
| 1289 | (forward-line -1) | ||
| 1290 | (if (<= (point) (nth 8 ppss)) | ||
| 1291 | (progn (goto-char (1+ (nth 8 ppss))) (current-column)) | ||
| 1292 | (skip-chars-forward " \t") | ||
| 1293 | (if (looking-at (regexp-quote continue)) | ||
| 1294 | (current-column)))))))) | ||
| 1295 | |||
| 1296 | (defun smie-indent-comment-close () | ||
| 1297 | (and (boundp 'comment-end-skip) | ||
| 1298 | comment-end-skip | ||
| 1299 | (not (looking-at " \t*$")) ;Not just a \n comment-closer. | ||
| 1300 | (looking-at comment-end-skip) | ||
| 1301 | (nth 4 (syntax-ppss)) | ||
| 1302 | (save-excursion | ||
| 1303 | (goto-char (nth 8 (syntax-ppss))) | ||
| 1304 | (current-column)))) | ||
| 1305 | |||
| 1306 | (defun smie-indent-comment-inside () | ||
| 1307 | (and (nth 4 (syntax-ppss)) | ||
| 1308 | 'noindent)) | ||
| 1309 | |||
| 1310 | (defun smie-indent-after-keyword () | ||
| 1311 | ;; Indentation right after a special keyword. | ||
| 1312 | (save-excursion | ||
| 1313 | (let* ((pos (point)) | ||
| 1314 | (toklevel (smie-indent-backward-token)) | ||
| 1315 | (tok (car toklevel))) | ||
| 1316 | (cond | ||
| 1317 | ((null toklevel) nil) | ||
| 1318 | ((smie-indent--rule :after tok pos nil (point))) | ||
| 1319 | ;; The default indentation after a keyword/operator is | ||
| 1320 | ;; 0 for infix, t for prefix, and use another rule | ||
| 1321 | ;; for postfix. | ||
| 1322 | ((null (nth 2 toklevel)) nil) ;A closer. | ||
| 1323 | ((or (null (nth 1 toklevel)) ;An opener. | ||
| 1324 | (rassoc tok smie-closer-alist)) ;An inner. | ||
| 1325 | (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ; | ||
| 1326 | (t (smie-indent-virtual)))))) ;An infix. | ||
| 1327 | |||
| 1328 | (defun smie-indent-exps () | ||
| 1329 | ;; Indentation of sequences of simple expressions without | ||
| 1330 | ;; intervening keywords or operators. E.g. "a b c" or "g (balbla) f". | ||
| 1331 | ;; Can be a list of expressions or a function call. | ||
| 1332 | ;; If it's a function call, the first element is special (it's the | ||
| 1333 | ;; function). We distinguish function calls from mere lists of | ||
| 1334 | ;; expressions based on whether the preceding token is listed in | ||
| 1335 | ;; the `list-intro' entry of smie-indent-rules. | ||
| 1336 | ;; | ||
| 1337 | ;; TODO: to indent Lisp code, we should add a way to specify | ||
| 1338 | ;; particular indentation for particular args depending on the | ||
| 1339 | ;; function (which would require always skipping back until the | ||
| 1340 | ;; function). | ||
| 1341 | ;; TODO: to indent C code, such as "if (...) {...}" we might need | ||
| 1342 | ;; to add similar indentation hooks for particular positions, but | ||
| 1343 | ;; based on the preceding token rather than based on the first exp. | ||
| 1344 | (save-excursion | ||
| 1345 | (let ((positions nil) | ||
| 1346 | arg) | ||
| 1347 | (while (and (null (car (smie-backward-sexp))) | ||
| 1348 | (push (point) positions) | ||
| 1349 | (not (smie-indent--bolp)))) | ||
| 1350 | (save-excursion | ||
| 1351 | ;; Figure out if the atom we just skipped is an argument rather | ||
| 1352 | ;; than a function. | ||
| 1353 | (setq arg | ||
| 1354 | (or (null (car (smie-backward-sexp))) | ||
| 1355 | (funcall smie-rules-function :list-intro | ||
| 1356 | (funcall smie-backward-token-function))))) | ||
| 1357 | (cond | ||
| 1358 | ((null positions) | ||
| 1359 | ;; We're the first expression of the list. In that case, the | ||
| 1360 | ;; indentation should be (have been) determined by its context. | ||
| 1361 | nil) | ||
| 1362 | (arg | ||
| 1363 | ;; There's a previous element, and it's not special (it's not | ||
| 1364 | ;; the function), so let's just align with that one. | ||
| 1365 | (goto-char (car positions)) | ||
| 1366 | (current-column)) | ||
| 1367 | ((cdr positions) | ||
| 1368 | ;; We skipped some args plus the function and bumped into something. | ||
| 1369 | ;; Align with the first arg. | ||
| 1370 | (goto-char (cadr positions)) | ||
| 1371 | (current-column)) | ||
| 1372 | (positions | ||
| 1373 | ;; We're the first arg. | ||
| 1374 | (goto-char (car positions)) | ||
| 1375 | (+ (smie-indent--offset 'args) | ||
| 1376 | ;; We used to use (smie-indent-virtual), but that | ||
| 1377 | ;; doesn't seem right since it might then indent args less than | ||
| 1378 | ;; the function itself. | ||
| 1379 | (current-column))))))) | ||
| 1380 | |||
| 1381 | (defvar smie-indent-functions | ||
| 1382 | '(smie-indent-fixindent smie-indent-bob smie-indent-close | ||
| 1383 | smie-indent-comment smie-indent-comment-continue smie-indent-comment-close | ||
| 1384 | smie-indent-comment-inside smie-indent-keyword smie-indent-after-keyword | ||
| 1385 | smie-indent-exps) | ||
| 1386 | "Functions to compute the indentation. | ||
| 1387 | Each function is called with no argument, shouldn't move point, and should | ||
| 1388 | return either nil if it has no opinion, or an integer representing the column | ||
| 1389 | to which that point should be aligned, if we were to reindent it.") | ||
| 1390 | |||
| 1391 | (defun smie-indent-calculate () | ||
| 1392 | "Compute the indentation to use for point." | ||
| 1393 | (run-hook-with-args-until-success 'smie-indent-functions)) | ||
| 1394 | |||
| 1395 | (defun smie-indent-line () | ||
| 1396 | "Indent current line using the SMIE indentation engine." | ||
| 1397 | (interactive) | ||
| 1398 | (let* ((savep (point)) | ||
| 1399 | (indent (or (with-demoted-errors | ||
| 1400 | (save-excursion | ||
| 1401 | (forward-line 0) | ||
| 1402 | (skip-chars-forward " \t") | ||
| 1403 | (if (>= (point) savep) (setq savep nil)) | ||
| 1404 | (or (smie-indent-calculate) 0))) | ||
| 1405 | 0))) | ||
| 1406 | (if (not (numberp indent)) | ||
| 1407 | ;; If something funny is used (e.g. `noindent'), return it. | ||
| 1408 | indent | ||
| 1409 | (if (< indent 0) (setq indent 0)) ;Just in case. | ||
| 1410 | (if savep | ||
| 1411 | (save-excursion (indent-line-to indent)) | ||
| 1412 | (indent-line-to indent))))) | ||
| 1413 | |||
| 1414 | (defun smie-setup (grammar rules-function &rest keywords) | ||
| 1415 | "Setup SMIE navigation and indentation. | ||
| 1416 | GRAMMAR is a grammar table generated by `smie-prec2->grammar'. | ||
| 1417 | RULES-FUNCTION is a set of indentation rules for use on `smie-rules-function'. | ||
| 1418 | KEYWORDS are additional arguments, which can use the following keywords: | ||
| 1419 | - :forward-token FUN | ||
| 1420 | - :backward-token FUN" | ||
| 1421 | (set (make-local-variable 'smie-rules-function) rules-function) | ||
| 1422 | (set (make-local-variable 'smie-grammar) grammar) | ||
| 1423 | (set (make-local-variable 'indent-line-function) 'smie-indent-line) | ||
| 1424 | (set (make-local-variable 'forward-sexp-function) | ||
| 1425 | 'smie-forward-sexp-command) | ||
| 1426 | (while keywords | ||
| 1427 | (let ((k (pop keywords)) | ||
| 1428 | (v (pop keywords))) | ||
| 1429 | (case k | ||
| 1430 | (:forward-token | ||
| 1431 | (set (make-local-variable 'smie-forward-token-function) v)) | ||
| 1432 | (:backward-token | ||
| 1433 | (set (make-local-variable 'smie-backward-token-function) v)) | ||
| 1434 | (t (message "smie-setup: ignoring unknown keyword %s" k))))) | ||
| 1435 | (let ((ca (cdr (assq :smie-closer-alist grammar)))) | ||
| 1436 | (when ca | ||
| 1437 | (set (make-local-variable 'smie-closer-alist) ca) | ||
| 1438 | ;; Only needed for interactive calls to blink-matching-open. | ||
| 1439 | (set (make-local-variable 'blink-matching-check-function) | ||
| 1440 | #'smie-blink-matching-check) | ||
| 1441 | (add-hook 'post-self-insert-hook | ||
| 1442 | #'smie-blink-matching-open 'append 'local) | ||
| 1443 | (set (make-local-variable 'smie-blink-matching-triggers) | ||
| 1444 | (append smie-blink-matching-triggers | ||
| 1445 | ;; Rather than wait for SPC to blink, try to blink as | ||
| 1446 | ;; soon as we type the last char of a block ender. | ||
| 1447 | (let ((closers (sort (mapcar #'cdr smie-closer-alist) | ||
| 1448 | #'string-lessp)) | ||
| 1449 | (triggers ()) | ||
| 1450 | closer) | ||
| 1451 | (while (setq closer (pop closers)) | ||
| 1452 | (unless (and closers | ||
| 1453 | ;; FIXME: this eliminates prefixes of other | ||
| 1454 | ;; closers, but we should probably elimnate | ||
| 1455 | ;; prefixes of other keywords as well. | ||
| 1456 | (string-prefix-p closer (car closers))) | ||
| 1457 | (push (aref closer (1- (length closer))) triggers))) | ||
| 1458 | (delete-dups triggers))))))) | ||
| 1459 | |||
| 1460 | |||
| 1461 | (provide 'smie) | ||
| 1462 | ;;; smie.el ends here | ||