From 71e3276bc574257845c81c095d41ed58399089fe Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Oct 2013 17:16:20 -0400 Subject: [PATCH] * lisp/emacs-lisp/smie.el: New smie-config system. (smie-config): New defcustom. (smie-edebug, smie-config-show-indent, smie-config-set-indent) (smie-config-guess, smie-config-save): New commands. (smie-config--mode-local, smie-config--buffer-local) (smie-config--trace, smie-config--modefuns): New vars. (smie-config--advice, smie-config--mode-hook) (smie-config--setter, smie-config-local, smie-config--get-trace) (smie-config--guess-value, smie-config--guess): New functions. (smie-indent-forward-token, smie-indent-backward-token): Don't copy text properties. Treat "string fence" syntax like string syntax. * lisp/progmodes/sh-script.el (sh-use-smie): Change default. (sh-smie-sh-rules, sh-smie-rc-rules): Obey legacy sh-indent-* vars. (sh-var-value): Simplify by CSE. (sh-show-indent, sh-set-indent, sh-learn-line-indent) (sh-learn-buffer-indent): Redirect to their SMIE equivalent when SMIE is used. (sh-guess-basic-offset): Use cl-incf. (sh-guess-basic-offset): Use push+nreverse to avoid O(n^2). --- etc/NEWS | 6 + lisp/ChangeLog | 23 ++ lisp/emacs-lisp/smie.el | 354 +++++++++++++++++++++++- lisp/progmodes/sh-script.el | 653 +++++++++++++++++++++++--------------------- 4 files changed, 717 insertions(+), 319 deletions(-) diff --git a/etc/NEWS b/etc/NEWS index 052cbd2f97d..232a1bc8a4b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -216,6 +216,12 @@ You can pick the name of the function and the variables with `C-x 4 a'. * Changes in Specialized Modes and Packages in Emacs 24.4 +** SMIE indentation can be customized via `smie-config'. +The customizaton can be guessed by Emacs by providing a sample indented +file and letting SMIE learn from it. + +** sh-script now uses its SMIE indentation algorithm by default. + ** The debugger's `e' command evaluates the code in the context at point. This includes using the lexical environment at point, which means that `e' now lets you access lexical variables as well. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 12dfe1e1869..98a80fb21c7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,26 @@ +2013-10-24 Stefan Monnier + + * emacs-lisp/smie.el: New smie-config system. + (smie-config): New defcustom. + (smie-edebug, smie-config-show-indent, smie-config-set-indent) + (smie-config-guess, smie-config-save): New commands. + (smie-config--mode-local, smie-config--buffer-local) + (smie-config--trace, smie-config--modefuns): New vars. + (smie-config--advice, smie-config--mode-hook) + (smie-config--setter, smie-config-local, smie-config--get-trace) + (smie-config--guess-value, smie-config--guess): New functions. + (smie-indent-forward-token, smie-indent-backward-token): Don't copy + text properties. Treat "string fence" syntax like string syntax. + + * progmodes/sh-script.el (sh-use-smie): Change default. + (sh-smie-sh-rules, sh-smie-rc-rules): Obey legacy sh-indent-* vars. + (sh-var-value): Simplify by CSE. + (sh-show-indent, sh-set-indent, sh-learn-line-indent) + (sh-learn-buffer-indent): Redirect to their SMIE equivalent when SMIE + is used. + (sh-guess-basic-offset): Use cl-incf. + (sh-guess-basic-offset): Use push+nreverse to avoid O(n^2). + 2013-10-24 Helmut Eller * emacs-lisp/lisp-mode.el (lisp-cl-font-lock-keywords-2): Fix cut&paste diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index f1ffdec5ec4..c4daa7a853f 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1370,9 +1370,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) @@ -1387,9 +1387,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) @@ -1829,6 +1829,352 @@ KEYWORDS are additional arguments, which can use the following keywords: (append smie-blink-matching-triggers (delete-dups triggers))))))) +(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"))) + +;;; 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." + :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. + (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)))))))))) + (message "Guessing...done") + rules)))) + +(defun smie-config-guess () + "Try and figure out this buffer's indentation settings." + (interactive) + (let ((config (smie-config--guess (point-min) (point-max)))) + (cond + ((null config) (message "Nothing to change")) + ((null smie-config--buffer-local) + (message "Local rules set") + (setq smie-config--buffer-local config)) + ((y-or-n-p "Replace existing local config? ") + (message "Local rules replaced") + (setq smie-config--buffer-local config)) + ((y-or-n-p "Merge with existing local config? ") + (message "Local rules adjusted") + (setq smie-config--buffer-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." + (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 diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index f834d7f3217..9f5486a08df 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1721,7 +1721,7 @@ This adds rules for comments and assignments." ;; the various indentation custom-vars, and it misses some important features ;; of the old code, mostly: sh-learn-line/buffer-indent, sh-show-indent, ;; sh-name/save/load-style. -(defvar sh-use-smie nil +(defvar sh-use-smie t "Whether to use the SMIE code for navigation and indentation.") (defun sh-smie--keyword-p () @@ -1926,7 +1926,8 @@ May return nil if the line should not be treated as continued." (defun sh-smie-sh-rules (kind token) (pcase (cons kind token) (`(:elem . basic) sh-indentation) - (`(:after . "case-)") (or sh-indentation smie-indent-basic)) + (`(:after . "case-)") (- (sh-var-value 'sh-indent-for-case-alt) + (sh-var-value 'sh-indent-for-case-label))) ((and `(:before . ,_) (guard (when sh-indent-after-continuation (save-excursion @@ -1960,6 +1961,21 @@ May return nil if the line should not be treated as continued." (current-column) (smie-indent-calculate))))) (`(:after . "|") (if (smie-rule-parent-p "|") nil 4)) + ;; Attempt at backward compatibility with the old config variables. + (`(:before . "fi") (sh-var-value 'sh-indent-for-fi)) + (`(:before . "done") (sh-var-value 'sh-indent-for-done)) + (`(:after . "else") (sh-var-value 'sh-indent-after-else)) + (`(:after . "if") (sh-var-value 'sh-indent-after-if)) + (`(:before . "then") (sh-var-value 'sh-indent-for-then)) + (`(:before . "do") (sh-var-value 'sh-indent-for-do)) + (`(:after . "do") + (sh-var-value (if (smie-rule-hanging-p) + 'sh-indent-after-loop-construct 'sh-indent-after-do))) + ;; sh-indent-after-done: aligned completely differently. + (`(:after . "in") (sh-var-value 'sh-indent-for-case-label)) + ;; sh-indent-for-continuation: Line continuations are handled differently. + (`(:after . ,(or `"(" `"{" `"[")) (sh-var-value 'sh-indent-after-open)) + ;; sh-indent-after-function: we don't handle it differently. )) ;; (defconst sh-smie-csh-grammar @@ -2119,8 +2135,9 @@ Point should be before the newline." (pcase (cons kind token) (`(:elem . basic) sh-indentation) ;; (`(:after . "case") (or sh-indentation smie-indent-basic)) - (`(:after . ";") (if (smie-rule-parent-p "case") - (smie-rule-parent sh-indentation))) + (`(:after . ";") + (if (smie-rule-parent-p "case") + (smie-rule-parent (sh-var-value 'sh-indent-after-case)))) (`(:before . "{") (save-excursion (when (sh-smie--rc-after-special-arg-p) @@ -2135,6 +2152,7 @@ Point should be before the newline." ;; with "(exp)", which is rarely the right thing to do, but is better ;; than nothing. (`(:list-intro . ,(or `"for" `"if" `"while")) t) + ;; sh-indent-after-switch: handled implicitly by the default { rule. )) ;;; End of SMIE code. @@ -3154,12 +3172,9 @@ IGNORE-ERROR is non-nil." ((eq val '/) (/ (- sh-basic-offset) 2)) (t - (if ignore-error - (progn - (message "Don't know how to handle %s's value of %s" var val) - 0) - (error "Don't know how to handle %s's value of %s" var val)) - )))) + (funcall (if ignore-error #'message #'error) + "Don't know how to handle %s's value of %s" var val) + 0)))) (defun sh-set-var-value (var value &optional no-symbol) "Set variable VAR to VALUE. @@ -3284,33 +3299,35 @@ If variable `sh-blink' is non-nil then momentarily go to the line we are indenting relative to, if applicable." (interactive "P") (sh-must-support-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - (curr-indent (current-indentation)) - val msg) - (if (stringp var) - (message "%s" (setq msg var)) - (setq val (sh-calculate-indent info)) - - (if (eq curr-indent val) - (setq msg (format "%s is %s" var (symbol-value var))) - (setq msg - (if val - (format "%s (%s) would change indent from %d to: %d" - var (symbol-value var) curr-indent val) - (format "%s (%s) would leave line as is" - var (symbol-value var))) - )) - (if (and arg var) - (describe-variable var))) - (if sh-blink - (let ((info (sh-get-indent-info))) - (if (and info (listp (car info)) - (eq (car (car info)) t)) - (sh-blink (nth 1 (car info)) msg) - (message "%s" msg))) - (message "%s" msg)) - )) + (if sh-use-smie + (smie-config-show-indent) + (let* ((info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + (curr-indent (current-indentation)) + val msg) + (if (stringp var) + (message "%s" (setq msg var)) + (setq val (sh-calculate-indent info)) + + (if (eq curr-indent val) + (setq msg (format "%s is %s" var (symbol-value var))) + (setq msg + (if val + (format "%s (%s) would change indent from %d to: %d" + var (symbol-value var) curr-indent val) + (format "%s (%s) would leave line as is" + var (symbol-value var))) + )) + (if (and arg var) + (describe-variable var))) + (if sh-blink + (let ((info (sh-get-indent-info))) + (if (and info (listp (car info)) + (eq (car (car info)) t)) + (sh-blink (nth 1 (car info)) msg) + (message "%s" msg))) + (message "%s" msg)) + ))) (defun sh-set-indent () "Set the indentation for the current line. @@ -3318,34 +3335,36 @@ If the current line is controlled by an indentation variable, prompt for a new value for it." (interactive) (sh-must-support-indent) - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - val old-val indent-val) - (if (stringp var) - (message "Cannot set indent - %s" var) - (setq old-val (symbol-value var)) - (setq val (sh-read-variable var)) - (condition-case nil - (progn - (set var val) - (setq indent-val (sh-calculate-indent info)) - (if indent-val - (message "Variable: %s Value: %s would indent to: %d" - var (symbol-value var) indent-val) - (message "Variable: %s Value: %s would leave line as is." - var (symbol-value var))) - ;; I'm not sure about this, indenting it now? - ;; No. Because it would give the impression that an undo would - ;; restore thing, but the value has been altered. - ;; (sh-indent-line) - ) - (error - (set var old-val) - (message "Bad value for %s, restoring to previous value %s" - var old-val) - (sit-for 1) - nil)) - ))) + (if sh-use-smie + (smie-config-set-indent) + (let* ((info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + val old-val indent-val) + (if (stringp var) + (message "Cannot set indent - %s" var) + (setq old-val (symbol-value var)) + (setq val (sh-read-variable var)) + (condition-case nil + (progn + (set var val) + (setq indent-val (sh-calculate-indent info)) + (if indent-val + (message "Variable: %s Value: %s would indent to: %d" + var (symbol-value var) indent-val) + (message "Variable: %s Value: %s would leave line as is." + var (symbol-value var))) + ;; I'm not sure about this, indenting it now? + ;; No. Because it would give the impression that an undo would + ;; restore thing, but the value has been altered. + ;; (sh-indent-line) + ) + (error + (set var old-val) + (message "Bad value for %s, restoring to previous value %s" + var old-val) + (sit-for 1) + nil)) + )))) (defun sh-learn-line-indent (arg) @@ -3359,55 +3378,57 @@ If the value can be represented by one of the symbols then do so unless optional argument ARG (the prefix when interactive) is non-nil." (interactive "*P") (sh-must-support-indent) - ;; I'm not sure if we show allow learning on an empty line. - ;; Though it might occasionally be useful I think it usually - ;; would just be confusing. - (if (save-excursion - (beginning-of-line) - (looking-at "\\s-*$")) - (message "sh-learn-line-indent ignores empty lines.") - (let* ((info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - ival sval diff new-val - (no-symbol arg) - (curr-indent (current-indentation))) - (cond - ((stringp var) - (message "Cannot learn line - %s" var)) - ((eq var 'sh-indent-comment) - ;; This is arbitrary... - ;; - if curr-indent is 0, set to curr-indent - ;; - else if it has the indentation of a "normal" line, - ;; then set to t - ;; - else set to curr-indent. - (setq sh-indent-comment - (if (= curr-indent 0) - 0 - (let* ((sh-indent-comment t) - (val2 (sh-calculate-indent info))) - (if (= val2 curr-indent) - t - curr-indent)))) - (message "%s set to %s" var (symbol-value var)) - ) - ((numberp (setq sval (sh-var-value var))) - (setq ival (sh-calculate-indent info)) - (setq diff (- curr-indent ival)) - - (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s" - curr-indent ival diff var sval) - (setq new-val (+ sval diff)) -;;; I commented out this because someone might want to replace -;;; a value of `+' with the current value of sh-basic-offset -;;; or vice-versa. -;;; (if (= 0 diff) -;;; (message "No change needed!") - (sh-set-var-value var new-val no-symbol) - (message "%s set to %s" var (symbol-value var)) - ) - (t - (debug) - (message "Cannot change %s" var)))))) + (if sh-use-smie + (smie-config-set-indent) + ;; I'm not sure if we show allow learning on an empty line. + ;; Though it might occasionally be useful I think it usually + ;; would just be confusing. + (if (save-excursion + (beginning-of-line) + (looking-at "\\s-*$")) + (message "sh-learn-line-indent ignores empty lines.") + (let* ((info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + ival sval diff new-val + (no-symbol arg) + (curr-indent (current-indentation))) + (cond + ((stringp var) + (message "Cannot learn line - %s" var)) + ((eq var 'sh-indent-comment) + ;; This is arbitrary... + ;; - if curr-indent is 0, set to curr-indent + ;; - else if it has the indentation of a "normal" line, + ;; then set to t + ;; - else set to curr-indent. + (setq sh-indent-comment + (if (= curr-indent 0) + 0 + (let* ((sh-indent-comment t) + (val2 (sh-calculate-indent info))) + (if (= val2 curr-indent) + t + curr-indent)))) + (message "%s set to %s" var (symbol-value var)) + ) + ((numberp (setq sval (sh-var-value var))) + (setq ival (sh-calculate-indent info)) + (setq diff (- curr-indent ival)) + + (sh-debug "curr-indent: %d ival: %d diff: %d var:%s sval %s" + curr-indent ival diff var sval) + (setq new-val (+ sval diff)) + ;; I commented out this because someone might want to replace + ;; a value of `+' with the current value of sh-basic-offset + ;; or vice-versa. + ;;(if (= 0 diff) + ;; (message "No change needed!") + (sh-set-var-value var new-val no-symbol) + (message "%s set to %s" var (symbol-value var)) + ) + (t + (debug) + (message "Cannot change %s" var))))))) @@ -3505,202 +3526,204 @@ removed in the future. This command can often take a long time to run." (interactive "P") (sh-must-support-indent) - (save-excursion - (goto-char (point-min)) - (let ((learned-var-list nil) - (out-buffer "*indent*") - (num-diffs 0) - previous-set-info - (max 17) - vec - msg - (comment-col nil) ;; number if all same, t if seen diff values - (comments-always-default t) ;; nil if we see one not default - initial-msg - (specified-basic-offset (and arg (numberp arg) - (> arg 0))) - (linenum 0) - suggested) - (setq vec (make-vector max 0)) - (sh-mark-init out-buffer) - - (if specified-basic-offset - (progn - (setq sh-basic-offset arg) - (setq initial-msg - (format "Using specified sh-basic-offset of %d" - sh-basic-offset))) - (setq initial-msg - (format "Initial value of sh-basic-offset: %s" - sh-basic-offset))) - - (while (< (point) (point-max)) - (setq linenum (1+ linenum)) - ;; (if (zerop (% linenum 10)) - (message "line %d" linenum) - ;; ) - (unless (looking-at "\\s-*$") ;; ignore empty lines! - (let* ((sh-indent-comment t) ;; info must return default indent - (info (sh-get-indent-info)) - (var (sh-get-indent-var-for-line info)) - sval ival diff new-val - (curr-indent (current-indentation))) - (cond - ((null var) - nil) - ((stringp var) - nil) - ((numberp (setq sval (sh-var-value var 'no-error))) - ;; the numberp excludes comments since sval will be t. - (setq ival (sh-calculate-indent)) - (setq diff (- curr-indent ival)) - (setq new-val (+ sval diff)) - (sh-set-var-value var new-val 'no-symbol) - (unless (looking-at "\\s-*#") ;; don't learn from comments - (if (setq previous-set-info (assoc var learned-var-list)) - (progn - ;; it was already there, is it same value ? - (unless (eq (symbol-value var) - (nth 1 previous-set-info)) - (sh-mark-line - (format "Variable %s was set to %s" - var (symbol-value var)) - (point) out-buffer t t) - (sh-mark-line - (format " but was previously set to %s" - (nth 1 previous-set-info)) - (nth 2 previous-set-info) out-buffer t) - (setq num-diffs (1+ num-diffs)) - ;; (delete previous-set-info learned-var-list) - (setcdr previous-set-info - (list (symbol-value var) (point))) - ) - ) - (setq learned-var-list - (append (list (list var (symbol-value var) - (point))) - learned-var-list))) - (if (numberp new-val) - (progn - (sh-debug - "This line's indent value: %d" new-val) - (if (< new-val 0) - (setq new-val (- new-val))) - (if (< new-val max) - (aset vec new-val (1+ (aref vec new-val)))))) - )) - ((eq var 'sh-indent-comment) - (unless (= curr-indent (sh-calculate-indent info)) - ;; this is not the default indentation - (setq comments-always-default nil) - (if comment-col ;; then we have see one before - (or (eq comment-col curr-indent) - (setq comment-col t)) ;; seen a different one - (setq comment-col curr-indent)) - )) - (t - (sh-debug "Cannot learn this line!!!") - )) - (sh-debug - "at %s learned-var-list is %s" (point) learned-var-list) - )) - (forward-line 1) - ) ;; while - (if sh-debug - (progn - (setq msg (format - "comment-col = %s comments-always-default = %s" - comment-col comments-always-default)) - ;; (message msg) - (sh-mark-line msg nil out-buffer))) - (cond - ((eq comment-col 0) - (setq msg "\nComments are all in 1st column.\n")) - (comments-always-default - (setq msg "\nComments follow default indentation.\n") - (setq comment-col t)) - ((numberp comment-col) - (setq msg (format "\nComments are in col %d." comment-col))) - (t - (setq msg "\nComments seem to be mixed, leaving them as is.\n") - (setq comment-col nil) - )) - (sh-debug msg) - (sh-mark-line msg nil out-buffer) - - (sh-mark-line initial-msg nil out-buffer t t) - - (setq suggested (sh-guess-basic-offset vec)) - - (if (and suggested (not specified-basic-offset)) - (let ((new-value - (cond - ;; t => set it if we have a single value as a number - ((and (eq sh-learn-basic-offset t) (numberp suggested)) - suggested) - ;; other non-nil => set it if only one value was found - (sh-learn-basic-offset - (if (numberp suggested) - suggested - (if (= (length suggested) 1) - (car suggested)))) - (t - nil)))) - (if new-value - (progn - (setq learned-var-list - (append (list (list 'sh-basic-offset - (setq sh-basic-offset new-value) - (point-max))) - learned-var-list)) - ;; Not sure if we need to put this line in, since - ;; it will appear in the "Learned variable settings". - (sh-mark-line - (format "Changed sh-basic-offset to: %d" sh-basic-offset) - nil out-buffer)) - (sh-mark-line - (if (listp suggested) - (format "Possible value(s) for sh-basic-offset: %s" - (mapconcat 'int-to-string suggested " ")) - (format "Suggested sh-basic-offset: %d" suggested)) - nil out-buffer)))) - - - (setq learned-var-list - (append (list (list 'sh-indent-comment comment-col (point-max))) - learned-var-list)) - (setq sh-indent-comment comment-col) - (let ((name (buffer-name))) - (sh-mark-line "\nLearned variable settings:" nil out-buffer) - (if arg - ;; Set learned variables to symbolic rather than numeric - ;; values where possible. - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var)) - (val (nth 1 learned-var))) - (when (and (not (eq var 'sh-basic-offset)) - (numberp val)) - (sh-set-var-value var val))))) - (dolist (learned-var (reverse learned-var-list)) - (let ((var (car learned-var))) - (sh-mark-line (format " %s %s" var (symbol-value var)) - (nth 2 learned-var) out-buffer))) - (with-current-buffer out-buffer - (goto-char (point-min)) - (let ((inhibit-read-only t)) - (insert - (format "Indentation values for buffer %s.\n" name) - (format "%d indentation variable%s different values%s\n\n" - num-diffs - (if (= num-diffs 1) - " has" "s have") - (if (zerop num-diffs) - "." ":")))))) - ;; Are abnormal hooks considered bad form? - (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) - (and (called-interactively-p 'any) - (or sh-popup-occur-buffer (> num-diffs 0)) - (pop-to-buffer out-buffer))))) + (if sh-use-smie + (smie-config-guess) + (save-excursion + (goto-char (point-min)) + (let ((learned-var-list nil) + (out-buffer "*indent*") + (num-diffs 0) + previous-set-info + (max 17) + vec + msg + (comment-col nil) ;; number if all same, t if seen diff values + (comments-always-default t) ;; nil if we see one not default + initial-msg + (specified-basic-offset (and arg (numberp arg) + (> arg 0))) + (linenum 0) + suggested) + (setq vec (make-vector max 0)) + (sh-mark-init out-buffer) + + (if specified-basic-offset + (progn + (setq sh-basic-offset arg) + (setq initial-msg + (format "Using specified sh-basic-offset of %d" + sh-basic-offset))) + (setq initial-msg + (format "Initial value of sh-basic-offset: %s" + sh-basic-offset))) + + (while (< (point) (point-max)) + (setq linenum (1+ linenum)) + ;; (if (zerop (% linenum 10)) + (message "line %d" linenum) + ;; ) + (unless (looking-at "\\s-*$") ;; ignore empty lines! + (let* ((sh-indent-comment t) ;; info must return default indent + (info (sh-get-indent-info)) + (var (sh-get-indent-var-for-line info)) + sval ival diff new-val + (curr-indent (current-indentation))) + (cond + ((null var) + nil) + ((stringp var) + nil) + ((numberp (setq sval (sh-var-value var 'no-error))) + ;; the numberp excludes comments since sval will be t. + (setq ival (sh-calculate-indent)) + (setq diff (- curr-indent ival)) + (setq new-val (+ sval diff)) + (sh-set-var-value var new-val 'no-symbol) + (unless (looking-at "\\s-*#") ;; don't learn from comments + (if (setq previous-set-info (assoc var learned-var-list)) + (progn + ;; it was already there, is it same value ? + (unless (eq (symbol-value var) + (nth 1 previous-set-info)) + (sh-mark-line + (format "Variable %s was set to %s" + var (symbol-value var)) + (point) out-buffer t t) + (sh-mark-line + (format " but was previously set to %s" + (nth 1 previous-set-info)) + (nth 2 previous-set-info) out-buffer t) + (setq num-diffs (1+ num-diffs)) + ;; (delete previous-set-info learned-var-list) + (setcdr previous-set-info + (list (symbol-value var) (point))) + ) + ) + (setq learned-var-list + (append (list (list var (symbol-value var) + (point))) + learned-var-list))) + (if (numberp new-val) + (progn + (sh-debug + "This line's indent value: %d" new-val) + (if (< new-val 0) + (setq new-val (- new-val))) + (if (< new-val max) + (aset vec new-val (1+ (aref vec new-val)))))) + )) + ((eq var 'sh-indent-comment) + (unless (= curr-indent (sh-calculate-indent info)) + ;; this is not the default indentation + (setq comments-always-default nil) + (if comment-col ;; then we have see one before + (or (eq comment-col curr-indent) + (setq comment-col t)) ;; seen a different one + (setq comment-col curr-indent)) + )) + (t + (sh-debug "Cannot learn this line!!!") + )) + (sh-debug + "at %s learned-var-list is %s" (point) learned-var-list) + )) + (forward-line 1) + ) ;; while + (if sh-debug + (progn + (setq msg (format + "comment-col = %s comments-always-default = %s" + comment-col comments-always-default)) + ;; (message msg) + (sh-mark-line msg nil out-buffer))) + (cond + ((eq comment-col 0) + (setq msg "\nComments are all in 1st column.\n")) + (comments-always-default + (setq msg "\nComments follow default indentation.\n") + (setq comment-col t)) + ((numberp comment-col) + (setq msg (format "\nComments are in col %d." comment-col))) + (t + (setq msg "\nComments seem to be mixed, leaving them as is.\n") + (setq comment-col nil) + )) + (sh-debug msg) + (sh-mark-line msg nil out-buffer) + + (sh-mark-line initial-msg nil out-buffer t t) + + (setq suggested (sh-guess-basic-offset vec)) + + (if (and suggested (not specified-basic-offset)) + (let ((new-value + (cond + ;; t => set it if we have a single value as a number + ((and (eq sh-learn-basic-offset t) (numberp suggested)) + suggested) + ;; other non-nil => set it if only one value was found + (sh-learn-basic-offset + (if (numberp suggested) + suggested + (if (= (length suggested) 1) + (car suggested)))) + (t + nil)))) + (if new-value + (progn + (setq learned-var-list + (append (list (list 'sh-basic-offset + (setq sh-basic-offset new-value) + (point-max))) + learned-var-list)) + ;; Not sure if we need to put this line in, since + ;; it will appear in the "Learned variable settings". + (sh-mark-line + (format "Changed sh-basic-offset to: %d" sh-basic-offset) + nil out-buffer)) + (sh-mark-line + (if (listp suggested) + (format "Possible value(s) for sh-basic-offset: %s" + (mapconcat 'int-to-string suggested " ")) + (format "Suggested sh-basic-offset: %d" suggested)) + nil out-buffer)))) + + + (setq learned-var-list + (append (list (list 'sh-indent-comment comment-col (point-max))) + learned-var-list)) + (setq sh-indent-comment comment-col) + (let ((name (buffer-name))) + (sh-mark-line "\nLearned variable settings:" nil out-buffer) + (if arg + ;; Set learned variables to symbolic rather than numeric + ;; values where possible. + (dolist (learned-var (reverse learned-var-list)) + (let ((var (car learned-var)) + (val (nth 1 learned-var))) + (when (and (not (eq var 'sh-basic-offset)) + (numberp val)) + (sh-set-var-value var val))))) + (dolist (learned-var (reverse learned-var-list)) + (let ((var (car learned-var))) + (sh-mark-line (format " %s %s" var (symbol-value var)) + (nth 2 learned-var) out-buffer))) + (with-current-buffer out-buffer + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (insert + (format "Indentation values for buffer %s.\n" name) + (format "%d indentation variable%s different values%s\n\n" + num-diffs + (if (= num-diffs 1) + " has" "s have") + (if (zerop num-diffs) + "." ":")))))) + ;; Are abnormal hooks considered bad form? + (run-hook-with-args 'sh-learned-buffer-hook learned-var-list) + (and (called-interactively-p 'any) + (or sh-popup-occur-buffer (> num-diffs 0)) + (pop-to-buffer out-buffer)))))) (defun sh-guess-basic-offset (vec) "See if we can determine a reasonable value for `sh-basic-offset'. @@ -3716,11 +3739,11 @@ Return values: (i 1) (totals (make-vector max 0))) (while (< i max) - (aset totals i (+ (aref totals i) (* 4 (aref vec i)))) + (cl-incf (aref totals i) (* 4 (aref vec i))) (if (zerop (% i 2)) - (aset totals i (+ (aref totals i) (aref vec (/ i 2))))) + (cl-incf (aref totals i) (aref vec (/ i 2)))) (if (< (* i 2) max) - (aset totals i (+ (aref totals i) (aref vec (* i 2))))) + (cl-incf (aref totals i) (aref vec (* i 2)))) (setq i (1+ i))) (let ((x nil) @@ -3729,10 +3752,10 @@ Return values: (setq i 1) (while (< i max) (if (/= (aref totals i) 0) - (setq x (append x (list (cons i (aref totals i)))))) + (push (cons i (aref totals i)) x)) (setq i (1+ i))) - (setq x (sort x (lambda (a b) (> (cdr a) (cdr b))))) + (setq x (sort (nreverse x) (lambda (a b) (> (cdr a) (cdr b))))) (setq tot (apply '+ (append totals nil))) (sh-debug (format "vec: %s\ntotals: %s\ntot: %d" vec totals tot)) -- 2.11.4.GIT