diff options
Diffstat (limited to 'lisp/emacs-lisp/smie.el')
| -rw-r--r-- | lisp/emacs-lisp/smie.el | 531 |
1 files changed, 475 insertions, 56 deletions
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index f9d0fd9366b..738bdddcddf 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1,6 +1,6 @@ ;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*- -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. +;; Copyright (C) 2010-2015 Free Software Foundation, Inc. ;; Author: Stefan Monnier <monnier@iro.umontreal.ca> ;; Keywords: languages, lisp, internal, parsing, indentation @@ -169,13 +169,13 @@ (cl-incf smie-warning-count)) (puthash key val table)))) -(put 'smie-precs->prec2 'pure t) (defun smie-precs->prec2 (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 share the same precedence level and associativity." + (declare (pure t)) (let ((prec2-table (make-hash-table :test 'equal))) (dolist (prec precs) (dolist (op (cdr prec)) @@ -193,8 +193,8 @@ one of those elements share the same precedence level and associativity." (smie-set-prec2tab prec2-table other-op op op1))))))) prec2-table)) -(put 'smie-merge-prec2s 'pure t) (defun smie-merge-prec2s (&rest tables) + (declare (pure t)) (if (null (cdr tables)) (car tables) (let ((prec2 (make-hash-table :test 'equal))) @@ -209,11 +209,10 @@ one of those elements share the same precedence level and associativity." table)) prec2))) -(put 'smie-bnf->prec2 'pure t) (defun smie-bnf->prec2 (bnf &rest resolvers) "Convert the BNF grammar into a prec2 table. BNF is a list of nonterminal definitions of the form: - \(NONTERM RHS1 RHS2 ...) + (NONTERM RHS1 RHS2 ...) where each RHS is a (non-empty) list of terminals (aka tokens) or non-terminals. Not all grammars are accepted: - an RHS cannot be an empty list (this is not needed, since SMIE allows all @@ -232,6 +231,7 @@ Conflicts can be resolved via RESOLVERS, which is a list of elements that can be either: - a precs table (see `smie-precs->prec2') to resolve conflicting constraints, - a constraint (T1 REL T2) where REL is one of = < or >." + (declare (pure t)) ;; FIXME: Add repetition operator like (repeat <separator> <elems>). ;; Maybe also add (or <elem1> <elem2>...) for things like ;; (exp (exp (or "+" "*" "=" ..) exp)). @@ -503,11 +503,11 @@ CSTS is a list of pairs representing arcs in a graph." ;; (t (cl-assert (eq v '=)))))))) ;; prec2)) -(put 'smie-prec2->grammar 'pure t) (defun smie-prec2->grammar (prec2) "Take a 2D precedence table and turn it into an alist of precedence levels. PREC2 is a table as returned by `smie-precs->prec2' or `smie-bnf->prec2'." + (declare (pure t)) ;; For each operator, we create two "variables" (corresponding to ;; the left and right precedence level), which are represented by ;; cons cells. Those are the very cons cells that appear in the @@ -612,8 +612,11 @@ PREC2 is a table as returned by `smie-precs->prec2' or (cons (pcase (cdr x) (`closer (cddr (assoc token table))) (`opener (cdr (assoc token table)))))) - (cl-assert (numberp (car cons))) - (setf (car cons) (list (car cons))))) + ;; `cons' can be nil for openers/closers which only contain + ;; "atomic" elements. + (when cons + (cl-assert (numberp (car cons))) + (setf (car cons) (list (car cons)))))) (let ((ca (gethash :smie-closer-alist prec2))) (when ca (push (cons :smie-closer-alist ca) table))) ;; (smie-check-grammar table prec2 'step3) @@ -632,14 +635,14 @@ e.g. a LEFT-LEVEL of nil means this is a token that behaves somewhat like an open-paren, whereas a RIGHT-LEVEL of nil would correspond to something like a close-paren.") -(defvar smie-forward-token-function 'smie-default-forward-token +(defvar smie-forward-token-function #'smie-default-forward-token "Function to scan forward for the next token. Called with no argument should return a token and move to its end. If no token is found, return nil or the empty string. It can return nil when bumping into a parenthesis, which lets SMIE use syntax-tables to handle them in efficient C code.") -(defvar smie-backward-token-function 'smie-default-backward-token +(defvar smie-backward-token-function #'smie-default-backward-token "Function to scan backward the previous token. Same calling convention as `smie-forward-token-function' except it should move backward to the beginning of the previous token.") @@ -707,13 +710,16 @@ Possible return values: ((null toklevels) (when (zerop (length token)) (condition-case err - (progn (goto-char pos) (funcall next-sexp 1) nil) + (progn (funcall next-sexp 1) nil) (scan-error - (let ((pos (nth 2 err))) + (let* ((epos1 (nth 2 err)) + (epos (if (<= (point) epos1) (nth 3 err) epos1))) + (goto-char pos) (throw 'return - (list t pos + (list t epos (buffer-substring-no-properties - pos (+ pos (if (< (point) pos) -1 1)))))))) + epos + (+ epos (if (< (point) epos) -1 1)))))))) (if (eq pos (point)) ;; We did not move, so let's abort the loop. (throw 'return (list t (point)))))) @@ -803,9 +809,9 @@ Possible return values: nil: we skipped over an identifier, matched parentheses, ..." (smie-next-sexp (indirect-function smie-backward-token-function) - (indirect-function 'backward-sexp) - (indirect-function 'smie-op-left) - (indirect-function 'smie-op-right) + (indirect-function #'backward-sexp) + (indirect-function #'smie-op-left) + (indirect-function #'smie-op-right) halfsexp)) (defun smie-forward-sexp (&optional halfsexp) @@ -824,19 +830,19 @@ Possible return values: nil: we skipped over an identifier, matched parentheses, ..." (smie-next-sexp (indirect-function smie-forward-token-function) - (indirect-function 'forward-sexp) - (indirect-function 'smie-op-right) - (indirect-function 'smie-op-left) + (indirect-function #'forward-sexp) + (indirect-function #'smie-op-right) + (indirect-function #'smie-op-left) halfsexp)) ;;; Miscellaneous commands using the precedence parser. -(defun smie-backward-sexp-command (&optional n) +(defun smie-backward-sexp-command (n) "Move backward through N logical elements." (interactive "^p") (smie-forward-sexp-command (- n))) -(defun smie-forward-sexp-command (&optional n) +(defun smie-forward-sexp-command (n) "Move forward through N logical elements." (interactive "^p") (let ((forw (> n 0)) @@ -1060,10 +1066,12 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer." (defun smie--matching-block-data (orig &rest args) "A function suitable for `show-paren-data-function' (which see)." (if (or (null smie-closer-alist) - (eq (point) (car smie--matching-block-data-cache))) + (equal (cons (point) (buffer-chars-modified-tick)) + (car smie--matching-block-data-cache))) (or (cdr smie--matching-block-data-cache) (apply orig args)) - (setq smie--matching-block-data-cache (list (point))) + (setq smie--matching-block-data-cache + (list (cons (point) (buffer-chars-modified-tick)))) (unless (nth 8 (syntax-ppss)) (condition-case nil (let ((here (smie--opener/closer-at-point))) @@ -1106,7 +1114,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer." (nth 1 there) (nth 2 there) (not (nth 0 there))))))) (scan-error nil)) - (goto-char (car smie--matching-block-data-cache))) + (goto-char (caar smie--matching-block-data-cache))) (apply #'smie--matching-block-data orig args))) ;;; The indentation engine. @@ -1116,7 +1124,7 @@ OPENER is non-nil if TOKEN is an opener and nil if it's a closer." :type 'integer :group 'smie) -(defvar smie-rules-function 'ignore +(defvar smie-rules-function #'ignore "Function providing the indentation rules. It takes two arguments METHOD and ARG where the meaning of ARG and the expected return value depends on METHOD. @@ -1128,9 +1136,15 @@ METHOD can be: - :elem, in which case the function should return either: - the offset to use to indent function arguments (ARG = `arg') - the basic indentation step (ARG = `basic'). + - the token to use (when ARG = `empty-line-token') when we don't know how + to indent an empty line. - :list-intro, in which case ARG is a token and the function should return non-nil if TOKEN is followed by a list of expressions (not separated by any token) rather than an expression. +- :close-all, in which case ARG is a close-paren token at indentation and + the function should return non-nil if it should be aligned with the opener + of the last close-paren token on the same line, if there are multiple. + Otherwise, it will be aligned with its own opener. When ARG is a token, the function is called with point just before that token. A return value of nil always means to fallback on the default behavior, so the @@ -1146,6 +1160,15 @@ NUMBER offset by NUMBER, relative to a base token The functions whose name starts with \"smie-rule-\" are helper functions designed specifically for use in this function.") +(defvar smie--hanging-eolp-function + ;; FIXME: This is a quick hack for 24.4. Don't document it and replace with + ;; a well-defined function with a cleaner interface instead! + (lambda () + (skip-chars-forward " \t") + (or (eolp) + (and ;; (looking-at comment-start-skip) ;(bug#16041). + (forward-comment (point-max)))))) + (defalias 'smie-rule-hanging-p 'smie-indent--hanging-p) (defun smie-indent--hanging-p () "Return non-nil if the current token is \"hanging\". @@ -1159,10 +1182,7 @@ the beginning of a line." (not (eobp)) ;; Could be an open-paren. (forward-char 1)) - (skip-chars-forward " \t") - (or (eolp) - (and (looking-at comment-start-skip) - (forward-comment (point-max)))) + (funcall smie--hanging-eolp-function) (point)))))) (defalias 'smie-rule-bolp 'smie-indent--bolp) @@ -1180,6 +1200,21 @@ Comments are treated as spaces." (forward-comment (- (point))) (<= (point) bol)))) +(defun smie-indent--current-column () + "Like `current-column', but if there's a comment before us, use that." + ;; This is used, so that when we align elements, we don't get + ;; toto = { /* foo, */ a, + ;; b } + ;; but + ;; toto = { /* foo, */ a, + ;; b } + (let ((pos (point)) + (lbp (line-beginning-position))) + (save-excursion + (unless (and (forward-comment -1) (>= (point) lbp)) + (goto-char pos)) + (current-column)))) + ;; Dynamically scoped. (defvar smie--parent) (defvar smie--after) (defvar smie--token) @@ -1232,14 +1267,7 @@ Only meaningful when called from within `smie-rules-function'." (goto-char (cadr (smie-indent--parent))) (cons 'column (+ (or offset 0) - ;; Use smie-indent-virtual when indenting relative to an opener: - ;; this will also by default use current-column unless - ;; that opener is hanging, but will additionally consult - ;; rules-function, so it gives it a chance to tweak - ;; indentation (e.g. by forcing indentation relative to - ;; its own parent, as in fn a => fn b => fn c =>). - (if (or (listp (car smie--parent)) (smie-indent--hanging-p)) - (smie-indent-virtual) (current-column)))))) + (smie-indent-virtual))))) (defvar smie-rule-separator-outdent 2) @@ -1319,8 +1347,8 @@ Only meaningful when called from within `smie-rules-function'." (defun smie-indent--rule (method token ;; FIXME: Too many parameters. &optional after parent base-pos) - "Compute indentation column according to `indent-rule-functions'. -METHOD and TOKEN are passed to `indent-rule-functions'. + "Compute indentation column according to `smie-rules-function'. +METHOD and TOKEN are passed to `smie-rules-function'. AFTER is the position after TOKEN, if known. PARENT is the parent info returned by `smie-backward-sexp', if known. BASE-POS is the position relative to which offsets should be applied." @@ -1333,11 +1361,7 @@ BASE-POS is the position relative to which offsets should be applied." ;; - :after tok, where ;; ; after is set; parent=nil; base-pos=point; (save-excursion - (let ((offset - (let ((smie--parent parent) - (smie--token token) - (smie--after after)) - (funcall smie-rules-function method token)))) + (let ((offset (smie-indent--rule-1 method token after parent))) (cond ((not offset) nil) ((eq (car-safe offset) 'column) (cdr offset)) @@ -1358,6 +1382,12 @@ BASE-POS is the position relative to which offsets should be applied." (smie-indent-virtual) (current-column))))) (t (error "Unknown indentation offset %s" offset)))))) +(defun smie-indent--rule-1 (method token &optional after parent) + (let ((smie--parent parent) + (smie--token token) + (smie--after after)) + (funcall smie-rules-function method token))) + (defun smie-indent-forward-token () "Skip token forward and return it, along with its levels." (let ((tok (funcall smie-forward-token-function))) @@ -1365,9 +1395,9 @@ BASE-POS is the position relative to which offsets should be applied." ((< 0 (length tok)) (assoc tok smie-grammar)) ((looking-at "\\s(\\|\\s)\\(\\)") (forward-char 1) - (cons (buffer-substring (1- (point)) (point)) + (cons (buffer-substring-no-properties (1- (point)) (point)) (if (match-end 1) '(0 nil) '(nil 0)))) - ((looking-at "\\s\"") + ((looking-at "\\s\"\\|\\s|") (forward-sexp 1) nil) ((eobp) nil) @@ -1382,9 +1412,9 @@ BASE-POS is the position relative to which offsets should be applied." ;; 4 == open paren syntax, 5 == close. ((memq (setq class (syntax-class (syntax-after (1- (point))))) '(4 5)) (forward-char -1) - (cons (buffer-substring (point) (1+ (point))) + (cons (buffer-substring-no-properties (point) (1+ (point))) (if (eq class 4) '(nil 0) '(0 nil)))) - ((eq class 7) + ((memq class '(7 15)) (backward-sexp 1) nil) ((bobp) nil) @@ -1426,8 +1456,13 @@ in order to figure out the indentation of some other (further down) point." (save-excursion ;; (forward-comment (point-max)) (when (looking-at "\\s)") - (while (not (zerop (skip-syntax-forward ")"))) - (skip-chars-forward " \t")) + (if (smie-indent--rule-1 :close-all + (buffer-substring-no-properties + (point) (1+ (point))) + (1+ (point))) + (while (not (zerop (skip-syntax-forward ")"))) + (skip-chars-forward " \t")) + (forward-char 1)) (condition-case nil (progn (backward-sexp 1) @@ -1559,7 +1594,9 @@ should not be computed on the basis of the following token." ;; So we use a heuristic here, which is that we only use virtual ;; if the parent is tightly linked to the child token (they're ;; part of the same BNF rule). - (if (car parent) (current-column) (smie-indent-virtual))))))))))) + (if (car parent) + (smie-indent--current-column) + (smie-indent-virtual))))))))))) (defun smie-indent-comment () "Compute indentation of a comment." @@ -1651,6 +1688,19 @@ should not be computed on the basis of the following token." (+ (smie-indent-virtual) (smie-indent--offset 'basic))) ; (t (smie-indent-virtual)))))) ;An infix. +(defun smie-indent-empty-line () + "Indentation rule when there's nothing yet on the line." + ;; Without this rule, SMIE assumes that an empty line will be filled with an + ;; argument (since it falls back to smie-indent-sexps), which tends + ;; to indent far too deeply. + (when (eolp) + (let ((token (or (funcall smie-rules-function :elem 'empty-line-token) + ;; FIXME: Should we default to ";"? + ;; ";" + ))) + (when (assoc token smie-grammar) + (smie-indent-keyword token))))) + (defun smie-indent-exps () ;; Indentation of sequences of simple expressions without ;; intervening keywords or operators. E.g. "a b c" or "g (balbla) f". @@ -1689,12 +1739,12 @@ should not be computed on the basis of the following token." ;; There's a previous element, and it's not special (it's not ;; the function), so let's just align with that one. (goto-char (car positions)) - (current-column)) + (smie-indent--current-column)) ((cdr positions) ;; We skipped some args plus the function and bumped into something. ;; Align with the first arg. (goto-char (cadr positions)) - (current-column)) + (smie-indent--current-column)) (positions ;; We're the first arg. (goto-char (car positions)) @@ -1702,14 +1752,14 @@ should not be computed on the basis of the following token." ;; We used to use (smie-indent-virtual), but that ;; doesn't seem right since it might then indent args less than ;; the function itself. - (current-column))))))) + (smie-indent--current-column))))))) (defvar smie-indent-functions '(smie-indent-fixindent smie-indent-bob smie-indent-close smie-indent-comment smie-indent-comment-continue smie-indent-comment-close smie-indent-comment-inside smie-indent-inside-string smie-indent-keyword smie-indent-after-keyword - smie-indent-exps) + smie-indent-empty-line smie-indent-exps) "Functions to compute the indentation. Each function is called with no argument, shouldn't move point, and should return either nil if it has no opinion, or an integer representing the column @@ -1824,6 +1874,375 @@ KEYWORDS are additional arguments, which can use the following keywords: (append smie-blink-matching-triggers (delete-dups triggers))))))) +(declare-function edebug-instrument-function "edebug" (func)) + +(defun smie-edebug () + "Instrument the `smie-rules-function' for Edebug." + (interactive) + (require 'edebug) + (if (symbolp smie-rules-function) + (edebug-instrument-function smie-rules-function) + (error "Sorry, don't know how to instrument a lambda expression"))) + +(defun smie--next-indent-change () + "Go to the next line that needs to be reindented (and reindent it)." + (interactive) + (while + (let ((tick (buffer-chars-modified-tick))) + (indent-according-to-mode) + (eq tick (buffer-chars-modified-tick))) + (forward-line 1))) + +;;; User configuration + +;; This is designed to be a completely independent "module", so we can play +;; with various kinds of smie-config modules without having to change the core. + +;; This smie-config module is fairly primitive and suffers from serious +;; restrictions: +;; - You can only change a returned offset, so you can't change the offset +;; passed to smie-rule-parent, nor can you change the object with which +;; to align (in general). +;; - The rewrite rule can only distinguish cases based on the kind+token arg +;; and smie-rules-function's return value, so you can't distinguish cases +;; where smie-rules-function returns the same value. +;; - Since config-rules depend on the return value of smie-rules-function, any +;; config change that modifies this return value (e.g. changing +;; foo-indent-basic) ends up invalidating config-rules. +;; This last one is a serious problem since it means that file-local +;; config-rules will only work if the user hasn't changed foo-indent-basic. +;; One possible way to change it is to modify smie-rules-functions so they can +;; return special symbols like +, ++, -, etc. Or make them use a new +;; smie-rule-basic function which can then be used to know when a returned +;; offset was computed based on foo-indent-basic. + +(defvar-local smie-config--mode-local nil + "Indentation config rules installed for this major mode. +Typically manipulated from the major-mode's hook.") +(defvar-local smie-config--buffer-local nil + "Indentation config rules installed for this very buffer. +E.g. provided via a file-local call to `smie-config-local'.") +(defvar smie-config--trace nil + "Variable used to trace calls to `smie-rules-function'.") + +(defun smie-config--advice (orig kind token) + (let* ((ret (funcall orig kind token)) + (sig (list kind token ret)) + (brule (rassoc sig smie-config--buffer-local)) + (mrule (rassoc sig smie-config--mode-local))) + (when smie-config--trace + (setq smie-config--trace (or brule mrule))) + (cond + (brule (car brule)) + (mrule (car mrule)) + (t ret)))) + +(defun smie-config--mode-hook (rules) + (setq smie-config--mode-local + (append rules smie-config--mode-local)) + (add-function :around (local 'smie-rules-function) #'smie-config--advice)) + +(defvar smie-config--modefuns nil) + +(defun smie-config--setter (var value) + (setq-default var value) + (let ((old-modefuns smie-config--modefuns)) + (setq smie-config--modefuns nil) + (pcase-dolist (`(,mode . ,rules) value) + (let ((modefunname (intern (format "smie-config--modefun-%s" mode)))) + (fset modefunname (lambda () (smie-config--mode-hook rules))) + (push modefunname smie-config--modefuns) + (add-hook (intern (format "%s-hook" mode)) modefunname))) + ;; Neuter any left-over previously installed hook. + (dolist (modefun old-modefuns) + (unless (memq modefun smie-config--modefuns) + (fset modefun #'ignore))))) + +(defcustom smie-config nil + ;; FIXME: there should be a file-local equivalent. + "User configuration of SMIE indentation. +This is a list of elements (MODE . RULES), where RULES is a list +of elements describing when and how to change the indentation rules. +Each RULE element should be of the form (NEW KIND TOKEN NORMAL), +where KIND and TOKEN are the elements passed to `smie-rules-function', +NORMAL is the value returned by `smie-rules-function' and NEW is the +value with which to replace it." + :version "24.4" + ;; FIXME improve value-type. + :type '(choice (const nil) + (alist :key-type symbol)) + :initialize 'custom-initialize-default + :set #'smie-config--setter) + +(defun smie-config-local (rules) + "Add RULES as local indentation rules to use in this buffer. +These replace any previous local rules, but supplement the rules +specified in `smie-config'." + (setq smie-config--buffer-local rules) + (add-function :around (local 'smie-rules-function) #'smie-config--advice)) + +;; Make it so we can set those in the file-local block. +;; FIXME: Better would be to be able to write "smie-config-local: (...)" rather +;; than "eval: (smie-config-local '(...))". +(put 'smie-config-local 'safe-local-eval-function t) + +(defun smie-config--get-trace () + (save-excursion + (forward-line 0) + (skip-chars-forward " \t") + (let* ((trace ()) + (srf-fun (lambda (orig kind token) + (let* ((pos (point)) + (smie-config--trace t) + (res (funcall orig kind token))) + (push (if (consp smie-config--trace) + (list pos kind token res smie-config--trace) + (list pos kind token res)) + trace) + res)))) + (unwind-protect + (progn + (add-function :around (local 'smie-rules-function) srf-fun) + (cons (smie-indent-calculate) + trace)) + (remove-function (local 'smie-rules-function) srf-fun))))) + +(defun smie-config-show-indent (&optional arg) + "Display the SMIE rules that are used to indent the current line. +If prefix ARG is given, then move briefly point to the buffer +position corresponding to each rule." + (interactive "P") + (let ((trace (cdr (smie-config--get-trace)))) + (cond + ((null trace) (message "No SMIE rules involved")) + ((not arg) + (message "Rules used: %s" + (mapconcat (lambda (elem) + (pcase-let ((`(,_pos ,kind ,token ,res ,rewrite) + elem)) + (format "%S %S -> %S%s" kind token res + (if (null rewrite) "" + (format "(via %S)" (nth 3 rewrite)))))) + trace + ", "))) + (t + (save-excursion + (pcase-dolist (`(,pos ,kind ,token ,res ,rewrite) trace) + (message "%S %S -> %S%s" kind token res + (if (null rewrite) "" + (format "(via %S)" (nth 3 rewrite)))) + (goto-char pos) + (sit-for blink-matching-delay))))))) + +(defun smie-config--guess-value (sig) + (add-function :around (local 'smie-rules-function) #'smie-config--advice) + (let* ((rule (cons 0 sig)) + (smie-config--buffer-local (cons rule smie-config--buffer-local)) + (goal (current-indentation)) + (cur (smie-indent-calculate))) + (cond + ((and (eq goal + (progn (setf (car rule) (- goal cur)) + (smie-indent-calculate)))) + (- goal cur))))) + +(defun smie-config-set-indent () + "Add a rule to adjust the indentation of current line." + (interactive) + (let* ((trace (cdr (smie-config--get-trace))) + (_ (unless trace (error "No SMIE rules involved"))) + (sig (if (null (cdr trace)) + (pcase-let* ((elem (car trace)) + (`(,_pos ,kind ,token ,res ,rewrite) elem)) + (list kind token (or (nth 3 rewrite) res))) + (let* ((choicestr + (completing-read + "Adjust rule: " + (mapcar (lambda (elem) + (format "%s %S" + (substring (symbol-name (cadr elem)) + 1) + (nth 2 elem))) + trace) + nil t nil nil + nil)) ;FIXME: Provide good default! + (choicelst (car (read-from-string + (concat "(:" choicestr ")"))))) + (catch 'found + (pcase-dolist (`(,_pos ,kind ,token ,res ,rewrite) trace) + (when (and (eq kind (car choicelst)) + (equal token (nth 1 choicelst))) + (throw 'found (list kind token + (or (nth 3 rewrite) res))))))))) + (default-new (smie-config--guess-value sig)) + (newstr (read-string (format "Adjust rule (%S %S -> %S) to%s: " + (nth 0 sig) (nth 1 sig) (nth 2 sig) + (if (not default-new) "" + (format " (default %S)" default-new))) + nil nil (format "%S" default-new))) + (new (car (read-from-string newstr)))) + (let ((old (rassoc sig smie-config--buffer-local))) + (when old + (setq smie-config--buffer-local + (remove old smie-config--buffer-local)))) + (push (cons new sig) smie-config--buffer-local) + (message "Added rule %S %S -> %S (via %S)" + (nth 0 sig) (nth 1 sig) new (nth 2 sig)) + (add-function :around (local 'smie-rules-function) #'smie-config--advice))) + +(defun smie-config--guess (beg end) + (let ((otraces (make-hash-table :test #'equal)) + (smie-config--buffer-local nil) + (smie-config--mode-local nil) + (pr (make-progress-reporter "Analyzing the buffer" beg end))) + + ;; First, lets get the indentation traces and offsets for the region. + (save-excursion + (goto-char beg) + (forward-line 0) + (while (< (point) end) + (skip-chars-forward " \t") + (unless (eolp) ;Skip empty lines. + (progress-reporter-update pr (point)) + (let* ((itrace (smie-config--get-trace)) + (nindent (car itrace)) + (trace (mapcar #'cdr (cdr itrace))) + (cur (current-indentation))) + (when (numberp nindent) ;Skip `noindent' and friends. + (cl-incf (gethash (cons (- cur nindent) trace) otraces 0))))) + (forward-line 1))) + (progress-reporter-done pr) + + ;; Second, compile the data. Our algorithm only knows how to adjust rules + ;; where the smie-rules-function returns an integer. We call those + ;; "adjustable sigs". We build a table mapping each adjustable sig + ;; to its data, describing the total number of times we encountered it, + ;; the offsets found, and the traces in which it was found. + (message "Guessing...") + (let ((sigs (make-hash-table :test #'equal))) + (maphash (lambda (otrace count) + (let ((offset (car otrace)) + (trace (cdr otrace)) + (double nil)) + (let ((sigs trace)) + (while sigs + (let ((sig (pop sigs))) + (if (and (integerp (nth 2 sig)) (member sig sigs)) + (setq double t))))) + (if double + ;; Disregard those traces where an adjustable sig + ;; appears twice, because the rest of the code assumes + ;; that adding a rule to add an offset N will change the + ;; end result by N rather than 2*N or more. + nil + (dolist (sig trace) + (if (not (integerp (nth 2 sig))) + ;; Disregard those sigs that return nil or a column, + ;; because our algorithm doesn't know how to adjust + ;; them anyway. + nil + (let ((sig-data (or (gethash sig sigs) + (let ((data (list 0 nil nil))) + (puthash sig data sigs) + data)))) + (cl-incf (nth 0 sig-data) count) + (push (cons count otrace) (nth 2 sig-data)) + (let ((sig-off-data + (or (assq offset (nth 1 sig-data)) + (let ((off-data (cons offset 0))) + (push off-data (nth 1 sig-data)) + off-data)))) + (cl-incf (cdr sig-off-data) count)))))))) + otraces) + + ;; Finally, guess the indentation rules. + (prog1 + (smie-config--guess-1 sigs) + (message "Guessing...done"))))) + +(defun smie-config--guess-1 (sigs) + (let ((ssigs nil) + (rules nil)) + ;; Sort the sigs by frequency of occurrence. + (maphash (lambda (sig sig-data) (push (cons sig sig-data) ssigs)) sigs) + (setq ssigs (sort ssigs (lambda (sd1 sd2) (> (cadr sd1) (cadr sd2))))) + (while ssigs + (pcase-let ((`(,sig ,total ,off-alist ,cotraces) (pop ssigs))) + (cl-assert (= total (apply #'+ (mapcar #'cdr off-alist)))) + (let* ((sorted-off-alist + (sort off-alist (lambda (x y) (> (cdr x) (cdr y))))) + (offset (caar sorted-off-alist))) + (if (zerop offset) + ;; Nothing to do with this sig; indentation is + ;; correct already. + nil + (push (cons (+ offset (nth 2 sig)) sig) rules) + ;; Adjust the rest of the data. + (pcase-dolist ((and cotrace `(,count ,toffset . ,trace)) + cotraces) + (setf (nth 1 cotrace) (- toffset offset)) + (dolist (sig trace) + (let ((sig-data (cdr (assq sig ssigs)))) + (when sig-data + (let* ((ooff-data (assq toffset (nth 1 sig-data))) + (noffset (- toffset offset)) + (noff-data + (or (assq noffset (nth 1 sig-data)) + (let ((off-data (cons noffset 0))) + (push off-data (nth 1 sig-data)) + off-data)))) + (cl-assert (>= (cdr ooff-data) count)) + (cl-decf (cdr ooff-data) count) + (cl-incf (cdr noff-data) count)))))))))) + rules)) + +(defun smie-config-guess () + "Try and figure out this buffer's indentation settings. +To save the result for future sessions, use `smie-config-save'." + (interactive) + (if (eq smie-grammar 'unset) + (user-error "This buffer does not seem to be using SMIE")) + (let ((config (smie-config--guess (point-min) (point-max)))) + (cond + ((null config) (message "Nothing to change")) + ((null smie-config--buffer-local) + (smie-config-local config) + (message "Local rules set")) + ((y-or-n-p "Replace existing local config? ") + (message "Local rules replaced") + (smie-config-local config)) + ((y-or-n-p "Merge with existing local config? ") + (message "Local rules adjusted") + (smie-config-local (append config smie-config--buffer-local))) + (t + (message "Rules guessed: %S" config))))) + +(defun smie-config-save () + "Save local rules for use with this major mode. +One way to generate local rules is the command `smie-config-guess'." + (interactive) + (cond + ((null smie-config--buffer-local) + (message "No local rules to save")) + (t + (let* ((existing (assq major-mode smie-config)) + (config + (cond ((null existing) + (message "Local rules saved in `smie-config'") + smie-config--buffer-local) + ((y-or-n-p "Replace the existing mode's config? ") + (message "Mode rules replaced in `smie-config'") + smie-config--buffer-local) + ((y-or-n-p "Merge with existing mode's config? ") + (message "Mode rules adjusted in `smie-config'") + (append smie-config--buffer-local (cdr existing))) + (t (error "Abort"))))) + (if existing + (setcdr existing config) + (push (cons major-mode config) smie-config)) + (setq smie-config--mode-local config) + (kill-local-variable 'smie-config--buffer-local) + (customize-mark-as-set 'smie-config))))) (provide 'smie) ;;; smie.el ends here |