5ad4bef575
* emacs-lisp/smie.el: New file. * progmodes/prolog.el (prolog-smie-op-levels) (prolog-smie-indent-rules): New var. (prolog-mode-variables): Use them to configure SMIE. (prolog-indent-line, prolog-indent-level): Remove.
688 lines
29 KiB
EmacsLisp
688 lines
29 KiB
EmacsLisp
;;; smie.el --- Simple Minded Indentation Engine
|
|
|
|
;; Copyright (C) 2010 Free Software Foundation, Inc.
|
|
|
|
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
|
|
;; Keywords: languages, lisp, internal, parsing, indentation
|
|
|
|
;; This file is part of GNU Emacs.
|
|
|
|
;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; GNU Emacs is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; While working on the SML indentation code, the idea grew that maybe
|
|
;; I could write something generic to do the same thing, and at the
|
|
;; end of working on the SML code, I had a pretty good idea of what it
|
|
;; could look like. That idea grew stronger after working on
|
|
;; LaTeX indentation.
|
|
;;
|
|
;; So at some point I decided to try it out, by writing a new
|
|
;; indentation code for Coq while trying to keep most of the code
|
|
;; "table driven", where only the tables are Coq-specific. The result
|
|
;; (which was used for Beluga-mode as well) turned out to be based on
|
|
;; something pretty close to an operator precedence parser.
|
|
|
|
;; So here is another rewrite, this time following the actual principles of
|
|
;; operator precedence grammars. Why OPG? Even though they're among the
|
|
;; weakest kinds of parsers, these parsers have some very desirable properties
|
|
;; for Emacs:
|
|
;; - most importantly for indentation, they work equally well in either
|
|
;; direction, so you can use them to parse backward from the indentation
|
|
;; point to learn the syntactic context;
|
|
;; - they work locally, so there's no need to keep a cache of
|
|
;; the parser's state;
|
|
;; - because of that locality, indentation also works just fine when earlier
|
|
;; parts of the buffer are syntactically incorrect since the indentation
|
|
;; looks at "as little as possible" of the buffer make an indentation
|
|
;; decision.
|
|
;; - they typically have no error handling and can't even detect a parsing
|
|
;; error, so we don't have to worry about what to do in case of a syntax
|
|
;; error because the parser just automatically does something. Better yet,
|
|
;; we can afford to use a sloppy grammar.
|
|
|
|
;; The development (especially the parts building the 2D precedence
|
|
;; tables and then computing the precedence levels from it) is largely
|
|
;; inspired from page 187-194 of "Parsing techniques" by Dick Grune
|
|
;; and Ceriel Jacobs (BookBody.pdf available at
|
|
;; http://www.cs.vu.nl/~dick/PTAPG.html).
|
|
;;
|
|
;; OTOH we had to kill many chickens, read many coffee grounds, and practiced
|
|
;; untold numbers of black magic spells.
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'cl))
|
|
|
|
;;; Building precedence level tables from BNF specs.
|
|
|
|
(defun smie-set-prec2tab (table x y val &optional override)
|
|
(assert (and x y))
|
|
(let* ((key (cons x y))
|
|
(old (gethash key table)))
|
|
(if (and old (not (eq old val)))
|
|
(if (gethash key override)
|
|
;; FIXME: The override is meant to resolve ambiguities,
|
|
;; but it also hides real conflicts. It would be great to
|
|
;; be able to distinguish the two cases so that overrides
|
|
;; don't hide real conflicts.
|
|
(puthash key (gethash key override) table)
|
|
(display-warning 'smie (format "Conflict: %s %s/%s %s" x old val y)))
|
|
(puthash key val table))))
|
|
|
|
(defun smie-precs-precedence-table (precs)
|
|
"Compute a 2D precedence table from a list of precedences.
|
|
PRECS should be a list, sorted by precedence (e.g. \"+\" will
|
|
come before \"*\"), of elements of the form \(left OP ...)
|
|
or (right OP ...) or (nonassoc OP ...) or (assoc OP ...). All operators in
|
|
one of those elements shares the same precedence level and associativity."
|
|
(let ((prec2-table (make-hash-table :test 'equal)))
|
|
(dolist (prec precs)
|
|
(dolist (op (cdr prec))
|
|
(let ((selfrule (cdr (assq (car prec)
|
|
'((left . >) (right . <) (assoc . =))))))
|
|
(when selfrule
|
|
(dolist (other-op (cdr prec))
|
|
(smie-set-prec2tab prec2-table op other-op selfrule))))
|
|
(let ((op1 '<) (op2 '>))
|
|
(dolist (other-prec precs)
|
|
(if (eq prec other-prec)
|
|
(setq op1 '> op2 '<)
|
|
(dolist (other-op (cdr other-prec))
|
|
(smie-set-prec2tab prec2-table op other-op op2)
|
|
(smie-set-prec2tab prec2-table other-op op op1)))))))
|
|
prec2-table))
|
|
|
|
(defun smie-merge-prec2s (tables)
|
|
(if (null (cdr tables))
|
|
(car tables)
|
|
(let ((prec2 (make-hash-table :test 'equal)))
|
|
(dolist (table tables)
|
|
(maphash (lambda (k v)
|
|
(smie-set-prec2tab prec2 (car k) (cdr k) v))
|
|
table))
|
|
prec2)))
|
|
|
|
(defun smie-bnf-precedence-table (bnf &rest precs)
|
|
(let ((nts (mapcar 'car bnf)) ;Non-terminals
|
|
(first-ops-table ())
|
|
(last-ops-table ())
|
|
(first-nts-table ())
|
|
(last-nts-table ())
|
|
(prec2 (make-hash-table :test 'equal))
|
|
(override (smie-merge-prec2s
|
|
(mapcar 'smie-precs-precedence-table precs)))
|
|
again)
|
|
(dolist (rules bnf)
|
|
(let ((nt (car rules))
|
|
(last-ops ())
|
|
(first-ops ())
|
|
(last-nts ())
|
|
(first-nts ()))
|
|
(dolist (rhs (cdr rules))
|
|
(assert (consp rhs))
|
|
(if (not (member (car rhs) nts))
|
|
(pushnew (car rhs) first-ops)
|
|
(pushnew (car rhs) first-nts)
|
|
(when (consp (cdr rhs))
|
|
;; If the first is not an OP we add the second (which
|
|
;; should be an OP if BNF is an "operator grammar").
|
|
;; Strictly speaking, this should only be done if the
|
|
;; first is a non-terminal which can expand to a phrase
|
|
;; without any OP in it, but checking doesn't seem worth
|
|
;; the trouble, and it lets the writer of the BNF
|
|
;; be a bit more sloppy by skipping uninteresting base
|
|
;; cases which are terminals but not OPs.
|
|
(assert (not (member (cadr rhs) nts)))
|
|
(pushnew (cadr rhs) first-ops)))
|
|
(let ((shr (reverse rhs)))
|
|
(if (not (member (car shr) nts))
|
|
(pushnew (car shr) last-ops)
|
|
(pushnew (car shr) last-nts)
|
|
(when (consp (cdr shr))
|
|
(assert (not (member (cadr shr) nts)))
|
|
(pushnew (cadr shr) last-ops)))))
|
|
(push (cons nt first-ops) first-ops-table)
|
|
(push (cons nt last-ops) last-ops-table)
|
|
(push (cons nt first-nts) first-nts-table)
|
|
(push (cons nt last-nts) last-nts-table)))
|
|
;; Compute all first-ops by propagating the initial ones we have
|
|
;; now, according to first-nts.
|
|
(setq again t)
|
|
(while (prog1 again (setq again nil))
|
|
(dolist (first-nts first-nts-table)
|
|
(let* ((nt (pop first-nts))
|
|
(first-ops (assoc nt first-ops-table)))
|
|
(dolist (first-nt first-nts)
|
|
(dolist (op (cdr (assoc first-nt first-ops-table)))
|
|
(unless (member op first-ops)
|
|
(setq again t)
|
|
(push op (cdr first-ops))))))))
|
|
;; Same thing for last-ops.
|
|
(setq again t)
|
|
(while (prog1 again (setq again nil))
|
|
(dolist (last-nts last-nts-table)
|
|
(let* ((nt (pop last-nts))
|
|
(last-ops (assoc nt last-ops-table)))
|
|
(dolist (last-nt last-nts)
|
|
(dolist (op (cdr (assoc last-nt last-ops-table)))
|
|
(unless (member op last-ops)
|
|
(setq again t)
|
|
(push op (cdr last-ops))))))))
|
|
;; Now generate the 2D precedence table.
|
|
(dolist (rules bnf)
|
|
(dolist (rhs (cdr rules))
|
|
(while (cdr rhs)
|
|
(cond
|
|
((member (car rhs) nts)
|
|
(dolist (last (cdr (assoc (car rhs) last-ops-table)))
|
|
(smie-set-prec2tab prec2 last (cadr rhs) '> override)))
|
|
((member (cadr rhs) nts)
|
|
(dolist (first (cdr (assoc (cadr rhs) first-ops-table)))
|
|
(smie-set-prec2tab prec2 (car rhs) first '< override))
|
|
(if (and (cddr rhs) (not (member (car (cddr rhs)) nts)))
|
|
(smie-set-prec2tab prec2 (car rhs) (car (cddr rhs))
|
|
'= override)))
|
|
(t (smie-set-prec2tab prec2 (car rhs) (cadr rhs) '= override)))
|
|
(setq rhs (cdr rhs)))))
|
|
prec2))
|
|
|
|
(defun smie-prec2-levels (prec2)
|
|
"Take a 2D precedence table and turn it into an alist of precedence levels.
|
|
PREC2 is a table as returned by `smie-precs-precedence-table' or
|
|
`smie-bnf-precedence-table'."
|
|
;; For each operator, we create two "variables" (corresponding to
|
|
;; the left and right precedence level), which are represented by
|
|
;; cons cells. Those are the vary cons cells that appear in the
|
|
;; final `table'. The value of each "variable" is kept in the `car'.
|
|
(let ((table ())
|
|
(csts ())
|
|
(eqs ())
|
|
tmp x y)
|
|
;; From `prec2' we construct a list of constraints between
|
|
;; variables (aka "precedence levels"). These can be either
|
|
;; equality constraints (in `eqs') or `<' constraints (in `csts').
|
|
(maphash (lambda (k v)
|
|
(if (setq tmp (assoc (car k) table))
|
|
(setq x (cddr tmp))
|
|
(setq x (cons nil nil))
|
|
(push (cons (car k) (cons nil x)) table))
|
|
(if (setq tmp (assoc (cdr k) table))
|
|
(setq y (cdr tmp))
|
|
(setq y (cons nil (cons nil nil)))
|
|
(push (cons (cdr k) y) table))
|
|
(ecase v
|
|
(= (push (cons x y) eqs))
|
|
(< (push (cons x y) csts))
|
|
(> (push (cons y x) csts))))
|
|
prec2)
|
|
;; First process the equality constraints.
|
|
(let ((eqs eqs))
|
|
(while eqs
|
|
(let ((from (caar eqs))
|
|
(to (cdar eqs)))
|
|
(setq eqs (cdr eqs))
|
|
(if (eq to from)
|
|
(debug) ;Can it happen?
|
|
(dolist (other-eq eqs)
|
|
(if (eq from (cdr other-eq)) (setcdr other-eq to))
|
|
(when (eq from (car other-eq))
|
|
;; This can happen because of `assoc' settings in precs
|
|
;; or because of a rhs like ("op" foo "op").
|
|
(setcar other-eq to)))
|
|
(dolist (cst csts)
|
|
(if (eq from (cdr cst)) (setcdr cst to))
|
|
(if (eq from (car cst)) (setcar cst to)))))))
|
|
;; Then eliminate trivial constraints iteratively.
|
|
(let ((i 0))
|
|
(while csts
|
|
(let ((rhvs (mapcar 'cdr csts))
|
|
(progress nil))
|
|
(dolist (cst csts)
|
|
(unless (memq (car cst) rhvs)
|
|
(setq progress t)
|
|
(setcar (car cst) i)
|
|
(setq csts (delq cst csts))))
|
|
(unless progress
|
|
(error "Can't resolve the precedence table to precedence levels")))
|
|
(incf i))
|
|
;; Propagate equalities back to their source.
|
|
(dolist (eq (nreverse eqs))
|
|
(assert (null (caar eq)))
|
|
(setcar (car eq) (cadr eq)))
|
|
;; Finally, fill in the remaining vars (which only appeared on the
|
|
;; right side of the < constraints).
|
|
;; Tho leaving them at nil is not a bad choice, since it makes
|
|
;; it clear that these don't bind at all.
|
|
;; (dolist (x table)
|
|
;; (unless (nth 1 x) (setf (nth 1 x) i))
|
|
;; (unless (nth 2 x) (setf (nth 2 x) i)))
|
|
)
|
|
table))
|
|
|
|
;;; Parsing using a precedence level table.
|
|
|
|
(defvar smie-op-levels 'unset
|
|
"List of token parsing info.
|
|
Each element is of the form (TOKEN LEFT-LEVEL RIGHT-LEVEL).
|
|
Parsing is done using an operator precedence parser.")
|
|
|
|
(defun smie-backward-token ()
|
|
;; FIXME: This may be an OK default but probably needs a hook.
|
|
(buffer-substring (point)
|
|
(progn (if (zerop (skip-syntax-backward "."))
|
|
(skip-syntax-backward "w_'"))
|
|
(point))))
|
|
|
|
(defun smie-forward-token ()
|
|
;; FIXME: This may be an OK default but probably needs a hook.
|
|
(buffer-substring (point)
|
|
(progn (if (zerop (skip-syntax-forward "."))
|
|
(skip-syntax-forward "w_'"))
|
|
(point))))
|
|
|
|
(defun smie-backward-sexp (&optional halfsexp)
|
|
"Skip over one sexp.
|
|
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
|
|
first token we see is an operator, skip over its left-hand-side argument.
|
|
Possible return values:
|
|
(LEFT-LEVEL POS TOKEN): we couldn't skip TOKEN because its right-level
|
|
is too high. LEFT-LEVEL is the left-level of TOKEN,
|
|
POS is its start position in the buffer.
|
|
(t POS TOKEN): Same thing but for an open-paren or the beginning of buffer.
|
|
(nil POS TOKEN): we skipped over a paren-like pair.
|
|
nil: we skipped over an identifier, matched parentheses, ..."
|
|
(if (bobp) (list t (point))
|
|
(catch 'return
|
|
(let ((levels ()))
|
|
(while
|
|
(let* ((pos (point))
|
|
(token (progn (forward-comment (- (point-max)))
|
|
(smie-backward-token)))
|
|
(toklevels (cdr (assoc token smie-op-levels))))
|
|
|
|
(cond
|
|
((null toklevels)
|
|
(if (equal token "")
|
|
(condition-case err
|
|
(progn (goto-char pos) (backward-sexp 1) nil)
|
|
(scan-error (throw 'return (list t (caddr err)))))))
|
|
((null (nth 1 toklevels))
|
|
;; A token like a paren-close.
|
|
(assert (nth 0 toklevels)) ;Otherwise, why mention it?
|
|
(push (nth 0 toklevels) levels))
|
|
(t
|
|
(while (and levels (< (nth 1 toklevels) (car levels)))
|
|
(setq levels (cdr levels)))
|
|
(cond
|
|
((null levels)
|
|
(if (and halfsexp (nth 0 toklevels))
|
|
(push (nth 0 toklevels) levels)
|
|
(throw 'return
|
|
(prog1 (list (or (car toklevels) t) (point) token)
|
|
(goto-char pos)))))
|
|
(t
|
|
(while (and levels (= (nth 1 toklevels) (car levels)))
|
|
(setq levels (cdr levels)))
|
|
(cond
|
|
((null levels)
|
|
(cond
|
|
((null (nth 0 toklevels))
|
|
(throw 'return (list nil (point) token)))
|
|
((eq (nth 0 toklevels) (nth 1 toklevels))
|
|
(throw 'return
|
|
(prog1 (list (or (car toklevels) t) (point) token)
|
|
(goto-char pos))))
|
|
(t (debug)))) ;Not sure yet what to do here.
|
|
(t
|
|
(if (nth 0 toklevels)
|
|
(push (nth 0 toklevels) levels))))))))
|
|
levels)
|
|
(setq halfsexp nil))))))
|
|
|
|
;; Mirror image, not used for indentation.
|
|
(defun smie-forward-sexp (&optional halfsexp)
|
|
"Skip over one sexp.
|
|
HALFSEXP if non-nil, means skip over a partial sexp if needed. I.e. if the
|
|
first token we see is an operator, skip over its left-hand-side argument.
|
|
Possible return values:
|
|
(RIGHT-LEVEL POS TOKEN): we couldn't skip TOKEN because its left-level
|
|
is too high. RIGHT-LEVEL is the right-level of TOKEN,
|
|
POS is its end position in the buffer.
|
|
(t POS TOKEN): Same thing but for an open-paren or the beginning of buffer.
|
|
(nil POS TOKEN): we skipped over a paren-like pair.
|
|
nil: we skipped over an identifier, matched parentheses, ..."
|
|
(if (eobp) (list t (point))
|
|
(catch 'return
|
|
(let ((levels ()))
|
|
(while
|
|
(let* ((pos (point))
|
|
(token (progn (forward-comment (point-max))
|
|
(smie-forward-token)))
|
|
(toklevels (cdr (assoc token smie-op-levels))))
|
|
|
|
(cond
|
|
((null toklevels)
|
|
(if (equal token "")
|
|
(condition-case err
|
|
(progn (goto-char pos) (forward-sexp 1) nil)
|
|
(scan-error (throw 'return (list t (caddr err)))))))
|
|
((null (nth 0 toklevels))
|
|
;; A token like a paren-close.
|
|
(assert (nth 1 toklevels)) ;Otherwise, why mention it?
|
|
(push (nth 1 toklevels) levels))
|
|
(t
|
|
(while (and levels (< (nth 0 toklevels) (car levels)))
|
|
(setq levels (cdr levels)))
|
|
(cond
|
|
((null levels)
|
|
(if (and halfsexp (nth 1 toklevels))
|
|
(push (nth 1 toklevels) levels)
|
|
(throw 'return
|
|
(prog1 (list (or (nth 1 toklevels) t) (point) token)
|
|
(goto-char pos)))))
|
|
(t
|
|
(while (and levels (= (nth 0 toklevels) (car levels)))
|
|
(setq levels (cdr levels)))
|
|
(cond
|
|
((null levels)
|
|
(cond
|
|
((null (nth 1 toklevels))
|
|
(throw 'return (list nil (point) token)))
|
|
((eq (nth 1 toklevels) (nth 0 toklevels))
|
|
(throw 'return
|
|
(prog1 (list (or (nth 1 toklevels) t) (point) token)
|
|
(goto-char pos))))
|
|
(t (debug)))) ;Not sure yet what to do here.
|
|
(t
|
|
(if (nth 1 toklevels)
|
|
(push (nth 1 toklevels) levels))))))))
|
|
levels)
|
|
(setq halfsexp nil))))))
|
|
|
|
(defun smie-backward-sexp-command (&optional n)
|
|
"Move backward through N logical elements."
|
|
(interactive "p")
|
|
(if (< n 0)
|
|
(smie-forward-sexp-command (- n))
|
|
(let ((forward-sexp-function nil))
|
|
(while (> n 0)
|
|
(decf n)
|
|
(let ((pos (point))
|
|
(res (smie-backward-sexp 'halfsexp)))
|
|
(if (and (car res) (= pos (point)) (not (bolp)))
|
|
(signal 'scan-error
|
|
(list "Containing expression ends prematurely"
|
|
(cadr res) (cadr res)))
|
|
nil))))))
|
|
|
|
(defun smie-forward-sexp-command (&optional n)
|
|
"Move forward through N logical elements."
|
|
(interactive "p")
|
|
(if (< n 0)
|
|
(smie-backward-sexp-command (- n))
|
|
(let ((forward-sexp-function nil))
|
|
(while (> n 0)
|
|
(decf n)
|
|
(let ((pos (point))
|
|
(res (smie-forward-sexp 'halfsexp)))
|
|
(if (and (car res) (= pos (point)) (not (bolp)))
|
|
(signal 'scan-error
|
|
(list "Containing expression ends prematurely"
|
|
(cadr res) (cadr res)))
|
|
nil))))))
|
|
|
|
;;; The indentation engine.
|
|
|
|
(defcustom smie-indent-basic 4
|
|
"Basic amount of indentation."
|
|
:type 'integer)
|
|
|
|
(defvar smie-indent-rules 'unset
|
|
"Rules of the following form.
|
|
\(TOK OFFSET) how to indent right after TOK.
|
|
\(TOK O1 O2) how to indent right after TOK:
|
|
O1 is the default;
|
|
O2 is used if TOK is \"hanging\".
|
|
\((T1 . T2) . OFFSET) how to indent token T2 w.r.t T1.
|
|
\((t . TOK) . OFFSET) how to indent TOK with respect to its parent.
|
|
\(list-intro . TOKENS) declare TOKENS as being followed by what may look like
|
|
a funcall but is just a sequence of expressions.
|
|
\(t . OFFSET) basic indentation step.
|
|
\(args . OFFSET) indentation of arguments.
|
|
A nil offset defaults to `smie-indent-basic'.")
|
|
|
|
(defun smie-indent-hanging-p ()
|
|
;; A Hanging keyword is one that's at the end of a line except it's not at
|
|
;; the beginning of a line.
|
|
(and (save-excursion (smie-forward-token)
|
|
(skip-chars-forward " \t") (eolp))
|
|
(save-excursion (skip-chars-backward " \t") (not (bolp)))))
|
|
|
|
(defun smie-bolp ()
|
|
(save-excursion (skip-chars-backward " \t") (bolp)))
|
|
|
|
(defun smie-indent-offset (elem)
|
|
(or (cdr (assq elem smie-indent-rules))
|
|
(cdr (assq t smie-indent-rules))
|
|
smie-indent-basic))
|
|
|
|
(defun smie-indent-calculate (&optional virtual)
|
|
"Compute the indentation to use for point.
|
|
If VIRTUAL is non-nil, it means we're not trying to indent point but just
|
|
need to compute the column at which point should be indented
|
|
in order to figure out the indentation of some other (further down) point.
|
|
VIRTUAL can take two different non-nil values:
|
|
- :bolp: means that the current indentation of point can be trusted
|
|
to be good only if if it follows a line break.
|
|
- :hanging: means that the current indentation of point can be
|
|
trusted to be good except if the following token is hanging."
|
|
;; FIXME: This has accumulated a lot of rules, some of which aren't
|
|
;; clearly orthogonal any more, so we should probably try and
|
|
;; restructure it somewhat.
|
|
(or
|
|
;; Trust pre-existing indentation on other lines.
|
|
(and virtual
|
|
(if (eq virtual :hanging) (not (smie-indent-hanging-p)) (smie-bolp))
|
|
(current-column))
|
|
;; Align close paren with opening paren.
|
|
(save-excursion
|
|
;; (forward-comment (point-max))
|
|
(when (looking-at "\\s)")
|
|
(while (not (zerop (skip-syntax-forward ")")))
|
|
(skip-chars-forward " \t"))
|
|
(condition-case nil
|
|
(progn
|
|
(backward-sexp 1)
|
|
(smie-indent-calculate :hanging))
|
|
(scan-error nil))))
|
|
;; Align closing token with the corresponding opening one.
|
|
;; (e.g. "of" with "case", or "in" with "let").
|
|
(save-excursion
|
|
(let* ((pos (point))
|
|
(token (smie-forward-token))
|
|
(toklevels (cdr (assoc token smie-op-levels))))
|
|
(when (car toklevels)
|
|
(let ((res (smie-backward-sexp 'halfsexp)) tmp)
|
|
;; If we didn't move at all, that means we didn't really skip
|
|
;; what we wanted.
|
|
(when (< (point) pos)
|
|
(cond
|
|
((eq (car res) (car toklevels))
|
|
;; We bumped into a same-level operator. align with it.
|
|
(goto-char (cadr res))
|
|
;; Don't use (smie-indent-calculate :hanging) here, because we
|
|
;; want to jump back over a sequence of same-level ops such as
|
|
;; a -> b -> c
|
|
;; -> d
|
|
;; So as to align with the earliest appropriate place.
|
|
(smie-indent-calculate :bolp))
|
|
((equal token (save-excursion
|
|
(forward-comment (- (point-max)))
|
|
(smie-backward-token)))
|
|
;; in cases such as "fn x => fn y => fn z =>",
|
|
;; jump back to the very first fn.
|
|
;; FIXME: should we only do that for special tokens like "=>"?
|
|
(smie-indent-calculate :bolp))
|
|
((setq tmp (assoc (cons (caddr res) token)
|
|
smie-indent-rules))
|
|
(goto-char (cadr res))
|
|
(+ (cdr tmp) (smie-indent-calculate :hanging)))
|
|
(t
|
|
(+ (or (cdr (assoc (cons t token) smie-indent-rules)) 0)
|
|
(current-column)))))))))
|
|
;; Indentation of a comment.
|
|
(and (looking-at comment-start-skip)
|
|
(save-excursion
|
|
(forward-comment (point-max))
|
|
(skip-chars-forward " \t\r\n")
|
|
(smie-indent-calculate nil)))
|
|
;; Indentation inside a comment.
|
|
(and (looking-at "\\*") (nth 4 (syntax-ppss))
|
|
(let ((ppss (syntax-ppss)))
|
|
(save-excursion
|
|
(forward-line -1)
|
|
(if (<= (point) (nth 8 ppss))
|
|
(progn (goto-char (1+ (nth 8 ppss))) (current-column))
|
|
(skip-chars-forward " \t")
|
|
(if (looking-at "\\*")
|
|
(current-column))))))
|
|
;; Indentation right after a special keyword.
|
|
(save-excursion
|
|
(let* ((tok (progn (forward-comment (- (point-max)))
|
|
(smie-backward-token)))
|
|
(tokinfo (assoc tok smie-indent-rules))
|
|
(toklevel (assoc tok smie-op-levels)))
|
|
(when (or tokinfo (and toklevel (null (cadr toklevel))))
|
|
(if (or (smie-indent-hanging-p)
|
|
;; If calculating the virtual indentation point, prefer
|
|
;; looking up the virtual indentation of the alignment
|
|
;; point as well. This is used for indentation after
|
|
;; "fn x => fn y =>".
|
|
virtual)
|
|
(+ (smie-indent-calculate :bolp)
|
|
(or (caddr tokinfo) (cadr tokinfo) (smie-indent-offset t)))
|
|
(+ (current-column)
|
|
(or (cadr tokinfo) (smie-indent-offset t)))))))
|
|
;; Main loop (FIXME: whatever that means!?).
|
|
(save-excursion
|
|
(let ((positions nil)
|
|
(begline nil)
|
|
arg)
|
|
(while (and (null (car (smie-backward-sexp)))
|
|
(push (point) positions)
|
|
(not (setq begline (smie-bolp)))))
|
|
(save-excursion
|
|
;; Figure out if the atom we just skipped is an argument rather
|
|
;; than a function.
|
|
(setq arg (or (null (car (smie-backward-sexp)))
|
|
(member (progn (forward-comment (- (point-max)))
|
|
(smie-backward-token))
|
|
(cdr (assoc 'list-intro smie-indent-rules))))))
|
|
(cond
|
|
((and arg positions)
|
|
(goto-char (car positions))
|
|
(current-column))
|
|
((and (null begline) (cdr positions))
|
|
;; We skipped some args plus the function and bumped into something.
|
|
;; Align with the first arg.
|
|
(goto-char (cadr positions))
|
|
(current-column))
|
|
((and (null begline) positions)
|
|
;; We're the first arg.
|
|
;; FIXME: it might not be a funcall, in which case we might be the
|
|
;; second element.
|
|
(goto-char (car positions))
|
|
(+ (smie-indent-offset 'args)
|
|
;; We used to use (smie-indent-calculate :bolp), but that
|
|
;; doesn't seem right since it might then indent args less than
|
|
;; the function itself.
|
|
(current-column)))
|
|
((and (null arg) (null positions))
|
|
;; We're the function itself. Not sure what to do here yet.
|
|
(if virtual (current-column)
|
|
(save-excursion
|
|
(let* ((pos (point))
|
|
(tok (progn (forward-comment (- (point-max)))
|
|
(smie-backward-token)))
|
|
(toklevels (cdr (assoc tok smie-op-levels))))
|
|
(cond
|
|
((numberp (car toklevels))
|
|
;; We're right after an infix token. Let's skip over the
|
|
;; lefthand side.
|
|
(goto-char pos)
|
|
(let (res)
|
|
(while (progn (setq res (smie-backward-sexp 'halfsexp))
|
|
(and (not (smie-bolp))
|
|
(equal (car res) (car toklevels)))))
|
|
;; We should be right after a token of equal or
|
|
;; higher precedence.
|
|
(cond
|
|
((and (consp res) (memq (car res) '(t nil)))
|
|
;; The token of higher-precedence is like an open-paren.
|
|
;; Sample case for t: foo { bar, \n[TAB] baz }.
|
|
;; Sample case for nil: match ... with \n[TAB] | toto ...
|
|
;; (goto-char (cadr res))
|
|
(smie-indent-calculate :hanging))
|
|
((and (consp res) (<= (car res) (car toklevels)))
|
|
;; We stopped at a token of equal or higher precedence
|
|
;; because we found a place with which to align.
|
|
(current-column))
|
|
)))
|
|
;; For other cases.... hmm... we'll see when we get there.
|
|
)))))
|
|
((null positions)
|
|
(smie-backward-token)
|
|
(+ (smie-indent-offset 'args) (smie-indent-calculate :bolp)))
|
|
((car (smie-backward-sexp))
|
|
;; No arg stands on its own line, but the function does:
|
|
(if (cdr positions)
|
|
(progn
|
|
(goto-char (cadr positions))
|
|
(current-column))
|
|
(goto-char (car positions))
|
|
(+ (current-column) (smie-indent-offset 'args))))
|
|
(t
|
|
;; We've skipped to a previous arg on its own line: align.
|
|
(goto-char (car positions))
|
|
(current-column)))))))
|
|
|
|
(defun smie-indent-line ()
|
|
"Indent current line using the SMIE indentation engine."
|
|
(interactive)
|
|
(let* ((savep (point))
|
|
(indent (condition-case nil
|
|
(save-excursion
|
|
(forward-line 0)
|
|
(skip-chars-forward " \t")
|
|
(if (>= (point) savep) (setq savep nil))
|
|
(or (smie-indent-calculate) 0))
|
|
(error 0))))
|
|
(if (not (numberp indent))
|
|
;; If something funny is used (e.g. `noindent'), return it.
|
|
indent
|
|
(if (< indent 0) (setq indent 0)) ;Just in case.
|
|
(if savep
|
|
(save-excursion (indent-line-to indent))
|
|
(indent-line-to indent)))))
|
|
|
|
;;;###autoload
|
|
(defun smie-setup (op-levels indent-rules)
|
|
(set (make-local-variable 'smie-indent-rules) indent-rules)
|
|
(set (make-local-variable 'smie-op-levels) op-levels)
|
|
(set (make-local-variable 'indent-line-function) 'smie-indent-line))
|
|
|
|
|
|
(provide 'smie)
|
|
;;; smie.el ends here
|