dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

sly-cl-indent.el (75111B)


      1 ;;; sly-cl-indent.el --- enhanced lisp-indent mode  -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 1987, 2000-2011 Free Software Foundation, Inc.
      4 
      5 ;; Author: Richard Mlynarik <mly@eddie.mit.edu>
      6 ;; Created: July 1987
      7 ;; Maintainer: FSF
      8 ;; Keywords: lisp, tools
      9 ;; Package: emacs
     10 
     11 ;; This file is forked from cl-indent.el, which is part of GNU Emacs.
     12 
     13 ;; GNU Emacs is free software: you can redistribute it and/or modify
     14 ;; it under the terms of the GNU General Public License as published by
     15 ;; the Free Software Foundation, either version 3 of the License, or
     16 ;; (at your option) any later version.
     17 
     18 ;; GNU Emacs is distributed in the hope that it will be useful,
     19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     21 ;; GNU General Public License for more details.
     22 
     23 ;; You should have received a copy of the GNU General Public License
     24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
     25 
     26 ;;; Commentary:
     27 
     28 ;; This package supplies a single entry point, `sly-common-lisp-indent-function',
     29 ;; which performs indentation in the preferred style for Common Lisp code.
     30 ;; To enable it:
     31 ;;
     32 ;; (setq lisp-indent-function 'sly-common-lisp-indent-function)
     33 ;;
     34 ;; This file is substantially patched from original cl-indent.el,
     35 ;; which is in Emacs proper. Although it is named after the SLY
     36 ;; library, it DOES NOT require it.  sly-cl-indent is instead required
     37 ;; by one of SLY's contribs, `sly-indentation'.
     38 ;;
     39 ;; Before making modifications to this file, consider adding them to
     40 ;; Emacs's own `cl-indent' and refactoring this file to be an
     41 ;; extension of Emacs's.
     42 ;;
     43 ;;; Code:
     44 (require 'cl-lib)
     45 
     46 (defgroup sly-lisp-indent nil
     47   "Indentation in Common Lisp."
     48   :group 'sly
     49   :group 'lisp-indent)
     50 
     51 (defcustom sly-lisp-indent-maximum-backtracking 6
     52   "Maximum depth to backtrack out from a sublist for structured indentation.
     53 If this variable is 0, no backtracking will occur and forms such as `flet'
     54 may not be correctly indented if this value is less than 4."
     55   :type 'integer
     56   :group 'sly-lisp-indent)
     57 
     58 (defcustom sly-lisp-tag-indentation 1
     59   "Indentation of tags relative to containing list.
     60 This variable is used by the function `sly--lisp-indent-tagbody'."
     61   :type 'integer
     62   :group 'sly-lisp-indent)
     63 
     64 (defcustom sly-lisp-tag-body-indentation 3
     65   "Indentation of non-tagged lines relative to containing list.
     66 This variable is used by the function `sly--lisp-indent-tagbody' to indent normal
     67 lines (lines without tags).
     68 The indentation is relative to the indentation of the parenthesis enclosing
     69 the special form.  If the value is t, the body of tags will be indented
     70 as a block at the same indentation as the first s-expression following
     71 the tag.  In this case, any forms before the first tag are indented
     72 by `lisp-body-indent'."
     73   :type 'integer
     74   :group 'sly-lisp-indent)
     75 
     76 (defcustom sly-lisp-backquote-indentation t
     77   "Whether or not to indent backquoted lists as code.
     78 If nil, indent backquoted lists as data, i.e., like quoted lists."
     79   :type 'boolean
     80   :group 'sly-lisp-indent)
     81 
     82 (defcustom sly-lisp-loop-indent-subclauses t
     83   "Whether or not to indent loop subclauses."
     84   :type 'boolean
     85   :group 'sly-lisp-indent)
     86 
     87 (defcustom sly-lisp-simple-loop-indentation 2
     88   "Indentation of forms in simple loop forms."
     89   :type 'integer
     90   :group 'sly-lisp-indent)
     91 
     92 (defcustom sly-lisp-loop-clauses-indentation 2
     93   "Indentation of loop clauses if `loop' is immediately followed by a newline."
     94   :type 'integer
     95   :group 'sly-lisp-indent)
     96 
     97 (defcustom sly-lisp-loop-indent-body-forms-relative-to-loop-start nil
     98   "When true, indent loop body clauses relative to the open paren of the loop
     99 form, instead of the keyword position."
    100   :type 'boolean
    101   :group 'sly-lisp-indent)
    102 
    103 (defcustom sly-lisp-loop-body-forms-indentation 3
    104   "Indentation of loop body clauses."
    105   :type 'integer
    106   :group 'sly-lisp-indent)
    107 
    108 (defcustom sly-lisp-loop-indent-forms-like-keywords nil
    109   "Whether or not to indent loop subforms just like
    110 loop keywords. Only matters when `sly-lisp-loop-indent-subclauses'
    111 is nil."
    112   :type 'boolean
    113   :group 'sly-lisp-indent)
    114 
    115 (defcustom sly-lisp-align-keywords-in-calls t
    116   "Whether to align keyword arguments vertically or not.
    117 If t (the default), keywords in contexts where no other
    118 indentation rule takes precedence are aligned like this:
    119 
    120 \(make-instance 'foo :bar t
    121                     :quux 42)
    122 
    123 If nil, they are indented like any other function
    124 call arguments:
    125 
    126 \(make-instance 'foo :bar t
    127                :quux 42)"
    128   :type 'boolean
    129   :group 'sly-lisp-indent)
    130 
    131 (defcustom sly-lisp-lambda-list-indentation t
    132   "Whether to indent lambda-lists specially. Defaults to t. Setting this to
    133 nil makes `sly-lisp-lambda-list-keyword-alignment',
    134 `sly-lisp-lambda-list-keyword-parameter-alignment', and
    135 `sly-lisp-lambda-list-keyword-parameter-indentation' meaningless, causing
    136 lambda-lists to be indented as if they were data:
    137 
    138 \(defun example (a b &optional o1 o2
    139                 o3 o4
    140                 &rest r
    141                 &key k1 k2
    142                 k3 k4)
    143   #|...|#)"
    144   :type 'boolean
    145   :group 'sly-lisp-indent)
    146 
    147 (defcustom sly-lisp-lambda-list-keyword-alignment nil
    148   "Whether to vertically align lambda-list keywords together.
    149 If nil (the default), keyworded lambda-list parts are aligned
    150 with the initial mandatory arguments, like this:
    151 
    152 \(defun foo (arg1 arg2 &rest rest
    153             &key key1 key2)
    154   #|...|#)
    155 
    156 If non-nil, alignment is done with the first keyword
    157 \(or falls back to the previous case), as in:
    158 
    159 \(defun foo (arg1 arg2 &rest rest
    160                       &key key1 key2)
    161   #|...|#)"
    162   :type 'boolean
    163   :group 'sly-lisp-indent)
    164 
    165 (defcustom sly-lisp-lambda-list-keyword-parameter-indentation 2
    166   "Indentation of lambda list keyword parameters.
    167 See `sly-lisp-lambda-list-keyword-parameter-alignment'
    168 for more information."
    169   :type 'integer
    170   :group 'sly-lisp-indent)
    171 
    172 (defcustom sly-lisp-lambda-list-keyword-parameter-alignment nil
    173   "Whether to vertically align lambda-list keyword parameters together.
    174 If nil (the default), the parameters are aligned
    175 with their corresponding keyword, plus the value of
    176 `sly-lisp-lambda-list-keyword-parameter-indentation', like this:
    177 
    178 \(defun foo (arg1 arg2 &key key1 key2
    179                         key3 key4)
    180   #|...|#)
    181 
    182 If non-nil, alignment is done with the first parameter
    183 \(or falls back to the previous case), as in:
    184 
    185 \(defun foo (arg1 arg2 &key key1 key2
    186                            key3 key4)
    187   #|...|#)"
    188   :type 'boolean
    189   :group 'sly-lisp-indent)
    190 
    191 
    192 ;; should this be a defcustom?
    193 (defvar sly-lisp-indent-defun-method '(4 &lambda &body)
    194   "Defun-like indentation method.
    195 This applies when the value of the `sly-common-lisp-indent-function' property
    196 is set to `defun'.")
    197 
    198 
    199 ;;;; Named styles.
    200 ;;;;
    201 ;;;; -*- common-lisp-style: foo -*-
    202 ;;;;
    203 ;;;; sets the style for the buffer.
    204 ;;;;
    205 ;;;; A Common Lisp style is a list of the form:
    206 ;;;;
    207 ;;;;  (NAME INHERIT VARIABLES INDENTATION HOOK DOCSTRING)
    208 ;;;;
    209 ;;;; where NAME is a symbol naming the style, INHERIT is the name of the style
    210 ;;;; it inherits from, VARIABLES is an alist specifying buffer local variables
    211 ;;;; for the style, and INDENTATION is an alist specifying non-standard
    212 ;;;; indentations for Common Lisp symbols. HOOK is a function to call when
    213 ;;;; activating the style. DOCSTRING is the documentation for the style.
    214 ;;;;
    215 ;;;; Convenience accessors `sly--common-lisp-style-name', &co exist.
    216 ;;;;
    217 ;;;; `sly-common-lisp-style' stores the name of the current style.
    218 ;;;;
    219 ;;;; `sly-common-lisp-style-default' stores the name of the style to use when none
    220 ;;;; has been specified.
    221 ;;;;
    222 ;;;; `sly--lisp-indent-active-style' stores a cons of the list specifying the
    223 ;;;; current style, and a hash-table containing all indentation methods of that
    224 ;;;; style and any styles it inherits from. Whenever we're indenting, we check
    225 ;;;; that this is up to date, and recompute when necessary.
    226 ;;;;
    227 ;;;; Just setting the buffer local sly-common-lisp-style will be enough to have
    228 ;;;; the style take effect. `sly-common-lisp-set-style' can also be called
    229 ;;;; explicitly, however, and offers name completion, etc.
    230 
    231 (cl-defstruct (sly--common-lisp-style
    232                 (:type list)
    233                 (:copier nil)
    234                 (:predicate nil)
    235                 (:constructor nil)
    236                 (:constructor sly--common-lisp-make-style
    237                     (name inherits variables
    238                      indentation hook docstring)))
    239   name inherits variables indentation hook docstring)
    240 
    241 ;;; Convenience accessors
    242 (defalias 'sly--lisp-indent-parse-state-start #'cl-second)
    243 (defalias 'sly--lisp-indent-parse-state-prev  #'cl-third)
    244 
    245 (defvar-local sly-common-lisp-style nil)
    246 
    247 ;;; `sly-define-common-lisp-style' updates the docstring of
    248 ;;; `sly-common-lisp-style', using this as the base.
    249 (put 'sly-common-lisp-style 'sly-common-lisp-style-base-doc
    250      "Name of the Common Lisp indentation style used in the current buffer.
    251 Set this by giving eg.
    252 
    253   ;; -*- common-lisp-style: sbcl -*-
    254 
    255 in the first line of the file, or by calling `sly-common-lisp-set-style'. If
    256 buffer has no style specified, but `sly-common-lisp-style-default' is set, that
    257 style is used instead. Use `sly-define-common-lisp-style' to define new styles.")
    258 
    259 ;;; `lisp-mode' kills all buffer-local variables. Setting the
    260 ;;; `permanent-local' property allows us to retain the style.
    261 (put 'sly-common-lisp-style 'permanent-local t)
    262 
    263 ;;; Mark as safe when the style doesn't evaluate arbitrary code.
    264 (put 'sly-common-lisp-style 'safe-local-variable 'sly--lisp-indent-safe-style-p)
    265 
    266 ;;; Common Lisp indentation style specifications.
    267 (defvar sly--common-lisp-styles (make-hash-table :test 'equal))
    268 
    269 ;; unused
    270 (defsubst sly--lisp-indent-delete-style (stylename)
    271   (remhash stylename sly--common-lisp-styles))
    272 
    273 (defun sly--lisp-indent-find-style (stylename)
    274   (let ((name (if (symbolp stylename)
    275                   (symbol-name stylename)
    276                 stylename)))
    277     (or (gethash name sly--common-lisp-styles)
    278         (error "Unknown Common Lisp style: %s" name))))
    279 
    280 (defun sly--lisp-indent-safe-style-p (stylename)
    281   "True for known Common Lisp style without an :EVAL option.
    282 Ie. styles that will not evaluate arbitrary code on activation."
    283   (let* ((style (ignore-errors (sly--lisp-indent-find-style stylename)))
    284          (base (sly--common-lisp-style-inherits style)))
    285     (and style
    286          (not (sly--common-lisp-style-hook style))
    287          (or (not base)
    288              (sly--lisp-indent-safe-style-p base)))))
    289 
    290 (defun sly--lisp-indent-add-style (stylename inherits variables
    291                                    indentation hooks documentation)
    292   ;; Invalidate indentation methods cached in common-lisp-active-style.
    293   (maphash (lambda (k v)
    294              (puthash k (cl-copy-list v) sly--common-lisp-styles))
    295            sly--common-lisp-styles)
    296   ;; Add/Redefine the specified style.
    297   (puthash stylename
    298            (sly--common-lisp-make-style
    299             stylename inherits
    300             variables indentation
    301             hooks documentation)
    302            sly--common-lisp-styles)
    303   ;; Frob `sly-common-lisp-style' docstring.
    304   (let ((doc (get 'sly-common-lisp-style
    305                   'sly-common-lisp-style-base-doc))
    306         (all nil))
    307     (setq doc (concat doc "\n\nAvailable styles are:\n"))
    308     (maphash (lambda (name style)
    309                (push (list name (sly--common-lisp-style-docstring style)) all))
    310              sly--common-lisp-styles)
    311     (dolist (info (sort all (lambda (a b) (string< (car a) (car b)))))
    312       (let ((style-name (cl-first info))
    313             (style-doc  (cl-second info)))
    314         (if style-doc
    315             (setq doc (concat doc
    316                               "\n " style-name "\n"
    317                               "   " style-doc "\n"))
    318           (setq doc (concat doc "\n " style-name " (undocumented)\n")))))
    319     (put 'sly-common-lisp-style 'variable-documentation doc))
    320   stylename)
    321 
    322 ;;; Activate STYLENAME, adding its indentation methods to METHODS -- and
    323 ;;; recurse on style inherited from.
    324 (defun sly--lisp-indent-activate-style (stylename methods)
    325   (let* ((style (sly--lisp-indent-find-style stylename))
    326          (basename (sly--common-lisp-style-inherits style)))
    327     ;; Recurse on parent.
    328     (when basename
    329       (sly--lisp-indent-activate-style basename methods))
    330     ;; Copy methods
    331     (dolist (spec (sly--common-lisp-style-indentation style))
    332       (puthash (cl-first spec) (cl-second spec) methods))
    333     ;; Bind variables.
    334     (dolist (var (sly--common-lisp-style-variables style))
    335       (set (make-local-variable (cl-first var)) (cl-second var)))
    336     ;; Run hook.
    337     (let ((hook (sly--common-lisp-style-hook style)))
    338       (when hook
    339         (funcall hook)))))
    340 
    341 ;;; When a style is being used, `sly--lisp-indent-active-style' holds a cons
    342 ;;;
    343 ;;;   (STYLE . METHODS)
    344 ;;;
    345 ;;; where STYLE is the list specifying the currently active style, and
    346 ;;; METHODS is the table of indentation methods --  including inherited
    347 ;;; ones -- for it. `sly--lisp-indent-active-style-methods' is reponsible
    348 ;;; for keeping this up to date.
    349 (defvar-local sly--lisp-indent-active-style nil)
    350 
    351 ;;; Makes sure sly--lisp-indent-active-style corresponds to sly-common-lisp-style, and
    352 ;;; pick up redefinitions, etc. Returns the method table for the currently
    353 ;;; active style.
    354 (defun sly--lisp-indent-active-style-methods ()
    355   (let* ((name (or sly-common-lisp-style (bound-and-true-p common-lisp-style)))
    356          (style (when name (sly--lisp-indent-find-style name))))
    357     (if (eq style (car sly--lisp-indent-active-style))
    358         (cdr sly--lisp-indent-active-style)
    359       (when style
    360         (let ((methods (make-hash-table :test 'equal)))
    361           (sly--lisp-indent-activate-style name methods)
    362           (setq sly--lisp-indent-active-style (cons style methods))
    363           methods)))))
    364 
    365 (defvar sly--lisp-indent-set-style-history nil)
    366 
    367 (defun sly--lisp-indent-style-names ()
    368   (let (names)
    369     (maphash (lambda (k v)
    370                (push (cons k v) names))
    371              sly--common-lisp-styles)
    372     names))
    373 
    374 ;;;###autoload
    375 (defun sly-common-lisp-set-style (stylename)
    376   "Set current buffer to use the Common Lisp style STYLENAME.
    377 STYLENAME, a string, must be an existing Common Lisp style. Styles
    378 are added (and updated) using `sly-define-common-lisp-style'.
    379 
    380 The buffer-local variable `sly-common-lisp-style' will get set to STYLENAME.
    381 
    382 A Common Lisp style is composed of local variables, indentation
    383 specifications, and may also contain arbitrary elisp code to run upon
    384 activation."
    385   (interactive
    386    (list (let ((completion-ignore-case t)
    387                (prompt "Specify Common Lisp indentation style: "))
    388            (completing-read prompt
    389                             (sly--lisp-indent-style-names) nil t nil
    390                             'sly--lisp-indent-set-style-history))))
    391   (setq sly-common-lisp-style (sly--common-lisp-style-name
    392                                (sly--lisp-indent-find-style stylename))
    393         sly--lisp-indent-active-style nil)
    394   ;; Actually activates the style.
    395   (sly--lisp-indent-active-style-methods)
    396   stylename)
    397 
    398 ;;;###autoload
    399 (defmacro sly-define-common-lisp-style (name documentation &rest options)
    400   "Define a Common Lisp indentation style.
    401 
    402 NAME is the name of the style.
    403 
    404 DOCUMENTATION is the docstring for the style, automatically added to the
    405 docstring of `sly-common-lisp-style'.
    406 
    407 OPTIONS are:
    408 
    409  (:variables (name value) ...)
    410 
    411   Specifying the buffer local variables associated with the style.
    412 
    413  (:indentation (symbol spec) ...)
    414 
    415   Specifying custom indentations associated with the style. SPEC is
    416   a normal `sly-common-lisp-indent-function' indentation specification.
    417 
    418  (:inherit style)
    419 
    420   Inherit variables and indentations from another Common Lisp style.
    421 
    422  (:eval form ...)
    423 
    424   Lisp code to evaluate when activating the style. This can be used to
    425   eg. activate other modes. It is possible that over the lifetime of
    426   a buffer same style gets activated multiple times, so code in :eval
    427   option should cope with that.
    428 "
    429   (declare (indent 1))
    430   (when (consp documentation)
    431     (setq options (cons documentation options)
    432           documentation nil))
    433   `(sly--lisp-indent-add-style ,name
    434                               ,(cadr (assoc :inherit options))
    435                               ',(cdr (assoc :variables options))
    436                               ',(cdr (assoc :indentation options))
    437                               ,(when (assoc :eval options)
    438                                  `(lambda ()
    439                                     ,@(cdr (assoc :eval options))))
    440                               ,documentation))
    441 
    442 (sly-define-common-lisp-style "basic-common"
    443   (:variables
    444    (sly-lisp-indent-maximum-backtracking 6)
    445    (sly-lisp-tag-indentation 1)
    446    (sly-lisp-tag-body-indentation 3)
    447    (sly-lisp-backquote-indentation t)
    448    (sly-lisp-loop-indent-subclauses t)
    449    (sly-lisp-loop-indent-forms-like-keywords nil)
    450    (sly-lisp-simple-loop-indentation 2)
    451    (sly-lisp-align-keywords-in-calls t)
    452    (sly-lisp-lambda-list-indentation t)
    453    (sly-lisp-lambda-list-keyword-alignment nil)
    454    (sly-lisp-lambda-list-keyword-parameter-indentation 2)
    455    (sly-lisp-lambda-list-keyword-parameter-alignment nil)
    456    (sly-lisp-indent-defun-method (4 &lambda &body))
    457    (sly-lisp-loop-clauses-indentation 2)
    458    (sly-lisp-loop-indent-body-forms-relative-to-loop-start nil)
    459    (sly-lisp-loop-body-forms-indentation 3)))
    460 
    461 (sly-define-common-lisp-style "basic-emacs25"
    462   "This style adds a workaround needed for Emacs 25"
    463   (:inherit "basic-common")
    464   (:variables
    465    ;; Without these (;;foo would get a space inserted between
    466    ;; ( and ; by indent-sexp.
    467    (comment-indent-function (lambda () nil))))
    468 
    469 (sly-define-common-lisp-style "basic-emacs26"
    470   "This style is the same as basic-common. It doesn't need or
    471    want the workaround used in Emacs 25. In Emacs 26, that
    472    workaround introduces a weird behavior where a single
    473    semicolon breaks the mode and causes the cursor to move to the
    474    start of the line after every character inserted."
    475   (:inherit "basic-common"))
    476 
    477 (sly-define-common-lisp-style "basic"
    478   "This style merely gives all identation variables their default values,
    479    making it easy to create new styles that are proof against user
    480    customizations. It also adjusts comment indentation from default.
    481    All other predefined modes inherit from basic."
    482   (:inherit (if (>= emacs-major-version 26)
    483                 "basic-emacs26"
    484               "basic-emacs25")))
    485 
    486 (sly-define-common-lisp-style "classic"
    487   "This style of indentation emulates the most striking features of 1995
    488    vintage cl-indent.el once included as part of Slime: IF indented by two
    489    spaces, and CASE clause bodies indentented more deeply than the keys."
    490   (:inherit "basic")
    491   (:variables
    492    (sly-lisp-lambda-list-keyword-parameter-indentation 0))
    493   (:indentation
    494    (case (4 &rest (&whole 2 &rest 3)))
    495    (if   (4 2 2))))
    496 
    497 (sly-define-common-lisp-style "modern"
    498   "A good general purpose style. Turns on lambda-list keyword and keyword
    499    parameter alignment, and turns subclause aware loop indentation off.
    500    (Loop indentation so because simpler style is more prevalent in existing
    501    sources, not because it is necessarily preferred.)"
    502   (:inherit "basic")
    503   (:variables
    504    (sly-lisp-lambda-list-keyword-alignment t)
    505    (sly-lisp-lambda-list-keyword-parameter-alignment t)
    506    (sly-lisp-lambda-list-keyword-parameter-indentation 0)
    507    (sly-lisp-loop-indent-subclauses nil)))
    508 
    509 (sly-define-common-lisp-style "sbcl"
    510   "Style used in SBCL sources. A good if somewhat intrusive general purpose
    511    style based on the \"modern\" style. Adds indentation for a few SBCL
    512    specific constructs, sets indentation to use spaces instead of tabs,
    513    fill-column to 78, and activates whitespace-mode to show tabs and trailing
    514    whitespace."
    515   (:inherit "modern")
    516   (:eval
    517    (whitespace-mode 1))
    518   (:variables
    519    (whitespace-style (tabs trailing))
    520    (indent-tabs-mode nil)
    521    (comment-fill-column nil)
    522    (fill-column 78))
    523   (:indentation
    524    (def!constant            (as defconstant))
    525    (def!macro               (as defmacro))
    526    (def!method              (as defmethod))
    527    (def!struct              (as defstruct))
    528    (def!type                (as deftype))
    529    (defmacro-mundanely      (as defmacro))
    530    (deftransform            (as defmacro))
    531    (define-source-transform (as defun))
    532    (!def-type-translator    (as defun))
    533    (!def-debug-command      (as defun))))
    534 
    535 (defcustom sly-common-lisp-style-default nil
    536   "Name of the Common Lisp indentation style to use in lisp-mode buffers if
    537 none has been specified."
    538   :type `(choice (const :tag "None" nil)
    539                  ,@(mapcar (lambda (spec)
    540                              `(const :tag ,(car spec) ,(car spec)))
    541                            (sly--lisp-indent-style-names))
    542                  (string :tag "Other"))
    543   :group 'sly-lisp-indent)
    544 
    545 ;;; If style is being used, that's a sufficient invitation to snag
    546 ;;; the indentation function.
    547 (defun sly--lisp-indent-lisp-mode-hook ()
    548   (let ((style (or sly-common-lisp-style
    549                    (bound-and-true-p common-lisp-style)
    550                    sly-common-lisp-style-default)))
    551     (when style
    552       (setq-local lisp-indent-function #'sly-common-lisp-indent-function)
    553       (sly-common-lisp-set-style style))))
    554 (add-hook 'lisp-mode-hook #'sly--lisp-indent-lisp-mode-hook)
    555 
    556 
    557 ;;;; The indentation specs are stored at three levels. In order of priority:
    558 ;;;;
    559 ;;;; 1. Indentation as set by current style, from the indentation table
    560 ;;;;    in the current style.
    561 ;;;;
    562 ;;;; 2. Globally set indentation, from the `sly-common-lisp-indent-function'
    563 ;;;;    property of the symbol.
    564 ;;;;
    565 ;;;; 3. Per-package indentation derived by the system. A live Common Lisp
    566 ;;;;    system may (via Slime, eg.) add indentation specs to
    567 ;;;;    sly-common-lisp-system-indentation, where they are associated with
    568 ;;;;    the package of the symbol. Then we run some lossy heuristics and
    569 ;;;;    find something that looks promising.
    570 ;;;;
    571 ;;;;    FIXME: for non-system packages the derived indentation should probably
    572 ;;;;    take precedence.
    573 
    574 ;;; This maps symbols into lists of (INDENT . PACKAGES) where INDENT is
    575 ;;; an indentation spec, and PACKAGES are the names of packages where this
    576 ;;; applies.
    577 ;;;
    578 ;;; We never add stuff here by ourselves: this is for things like Slime to
    579 ;;; fill.
    580 (defvar sly-common-lisp-system-indentation (make-hash-table :test 'equal))
    581 
    582 (defun sly--lisp-indent-guess-current-package ()
    583   (save-excursion
    584     (ignore-errors
    585       (when (let ((case-fold-search t))
    586               (search-backward "(in-package "))
    587         (re-search-forward "[ :\"]+")
    588         (let ((start (point)))
    589           (re-search-forward "[\":)]")
    590           (upcase (buffer-substring-no-properties
    591                    start (1- (point)))))))))
    592 
    593 (defvar sly--lisp-indent-current-package-function
    594   'sly--lisp-indent-guess-current-package
    595   "Used to derive the package name to use for indentation at a
    596 given point. Defaults to `sly--lisp-indent-guess-current-package'.")
    597 
    598 (defun sly--lisp-indent-symbol-package (string)
    599   (if (and (stringp string) (string-match ":" string))
    600       (let ((p (match-beginning 0)))
    601         (if (eq p 0)
    602             "KEYWORD"
    603           (upcase (substring string 0 p))))
    604     (funcall sly--lisp-indent-current-package-function)))
    605 
    606 (defun sly--lisp-indent-get-indentation (name &optional full)
    607   "Retrieves the indentation information for NAME."
    608   (let ((method
    609          (or
    610           ;; From style
    611           (let ((methods (sly--lisp-indent-active-style-methods)))
    612             (and methods (gethash name methods)))
    613           ;; From global settings.
    614           (get name 'sly-common-lisp-indent-function)
    615           (get name 'common-lisp-indent-function)
    616           ;; From system derived information.
    617           (let ((system-info (gethash name sly-common-lisp-system-indentation)))
    618             (if (not (cdr system-info))
    619                 (caar system-info)
    620               (let ((guess nil)
    621                     (guess-n 0)
    622                     (package (sly--lisp-indent-symbol-package full)))
    623                 (cl-dolist (info system-info guess)
    624                   (let* ((pkgs (cdr info))
    625                          (n (length pkgs)))
    626                     (cond ((member package pkgs)
    627                            ;; This is it.
    628                            (cl-return (car info)))
    629                           ((> n guess-n)
    630                            ;; If we can't find the real thing, go with the one
    631                            ;; accessible in most packages.
    632                            (setf guess (car info)
    633                                  guess-n n)))))))))))
    634     (if (eq 'as (car-safe method))
    635         (sly--lisp-indent-get-indentation (cadr method))
    636       method)))
    637 
    638 ;;;; LOOP indentation, the simple version
    639 
    640 (defun sly--lisp-indent-loop-type (loop-start)
    641   "Returns the type of the loop form at LOOP-START.
    642 Possible types are SIMPLE, SIMPLE/SPLIT, EXTENDED, and EXTENDED/SPLIT. */SPLIT
    643 refers to extended loops whose body does not start on the same line as the
    644 opening parenthesis of the loop."
    645   (let (comment-split)
    646     (condition-case ()
    647         (save-excursion
    648           (goto-char loop-start)
    649           (let ((line (line-number-at-pos))
    650                 (maybe-split t))
    651             (forward-char 1)
    652             (forward-sexp 1)
    653             (save-excursion
    654               (when (looking-at "\\s-*\\\n*;")
    655                 (search-forward ";")
    656                 (backward-char 1)
    657                 (if (= line (line-number-at-pos))
    658                     (setq maybe-split nil)
    659                   (setq comment-split t))))
    660             (forward-sexp 1)
    661             (backward-sexp 1)
    662             (if (eq (char-after) ?\()
    663                 (if (or (not maybe-split) (= line (line-number-at-pos)))
    664                     'simple
    665                   'simple/split)
    666               (if (or (not maybe-split) (= line (line-number-at-pos)))
    667                   'extended
    668                 'extended/split))))
    669       (error
    670        (if comment-split
    671            'simple/split
    672          'simple)))))
    673 
    674 (defun sly--lisp-indent-trailing-comment ()
    675   (ignore-errors
    676     ;; If we had a trailing comment just before this, find it.
    677     (save-excursion
    678       (backward-sexp)
    679       (forward-sexp)
    680       (when (looking-at "\\s-*;")
    681         (search-forward ";")
    682         (1- (current-column))))))
    683 
    684 ;;;###autoload
    685 (defun sly-common-lisp-indent-function (indent-point state)
    686   "Function to indent the arguments of a Lisp function call.
    687 This is suitable for use as the value of the variable
    688 `lisp-indent-function'.  INDENT-POINT is the point at which the
    689 indentation function is called, and STATE is the
    690 `parse-partial-sexp' state at that position.  Browse the
    691 `sly-lisp-indent' customize group for options affecting the behavior
    692 of this function.
    693 
    694 If the indentation point is in a call to a Lisp function, that
    695 function's `sly-common-lisp-indent-function' property specifies how
    696 this function should indent it.  Possible values for this
    697 property are:
    698 
    699 * defun, meaning indent according to
    700   `sly-lisp-indent-defun-method'; i.e., like (4 &lambda &body),
    701   as explained below.
    702 
    703 * any other symbol, meaning a function to call.  The function
    704   should take the arguments: PATH STATE INDENT-POINT SEXP-COLUMN
    705   NORMAL-INDENT.  PATH is a list of integers describing the
    706   position of point in terms of list-structure with respect to
    707   the containing lists.  For example, in
    708   ((a b c (d foo) f) g), foo has a path of (0 3 1). In other
    709   words, to reach foo take the 0th element of the outermost list,
    710   then the 3rd element of the next list, and finally the 1st
    711   element. STATE and INDENT-POINT are as in the arguments to
    712   `sly-common-lisp-indent-function'. SEXP-COLUMN is the column of
    713   the open parenthesis of the innermost containing list.
    714   NORMAL-INDENT is the column the indentation point was
    715   originally in. This function should behave like
    716   `sly--lisp-indent-259'.
    717 
    718 * an integer N, meaning indent the first N arguments like
    719   function arguments, and any further arguments like a body.
    720   This is equivalent to (4 4 ... &body).
    721 
    722 * a list starting with `as' specifies an indirection: indentation
    723   is done as if the form being indented had started with the
    724   second element of the list.
    725 
    726 * any other list.  The list element in position M specifies how
    727   to indent the Mth function argument.  If there are fewer
    728   elements than function arguments, the last list element applies
    729   to all remaining arguments.  The accepted list elements are:
    730 
    731   * nil, meaning the default indentation.
    732 
    733   * an integer, specifying an explicit indentation.
    734 
    735   * &lambda.  Indent the argument (which may be a list) by 4.
    736 
    737   * &rest.  When used, this must be the penultimate element.  The
    738     element after this one applies to all remaining arguments.
    739 
    740   * &body.  This is equivalent to &rest lisp-body-indent, i.e., indent
    741     all remaining elements by `lisp-body-indent'.
    742 
    743   * &whole.  This must be followed by nil, an integer, or a
    744     function symbol.  This indentation is applied to the
    745     associated argument, and as a base indent for all remaining
    746     arguments.  For example, an integer P means indent this
    747     argument by P, and all remaining arguments by P, plus the
    748     value specified by their associated list element.
    749 
    750   * a symbol.  A function to call, with the 6 arguments specified above.
    751 
    752   * a list, with elements as described above.  This applies when the
    753     associated function argument is itself a list.  Each element of the list
    754     specifies how to indent the associated argument.
    755 
    756 For example, the function `case' has an indent property
    757 \(4 &rest (&whole 2 &rest 1)), meaning:
    758   * indent the first argument by 4.
    759   * arguments after the first should be lists, and there may be any number
    760     of them.  The first list element has an offset of 2, all the rest
    761     have an offset of 2+1=3."
    762   (sly--lisp-indent-function-1 indent-point state))
    763 
    764 (define-minor-mode sly-lisp-indent-compatibility-mode
    765     "Replace the definition of `common-lisp-indent-function' with `sly-common-lisp-indent-function'.
    766 
    767 For backwards compatibility with the old sly-cl-indent.el, which
    768 used to do this by default."
    769   :group 'sly-lisp-indent
    770   (if sly-lisp-indent-compatibility-mode
    771       (advice-add 'common-lisp-indent-function
    772                   :override 'sly-common-lisp-indent-function)
    773     (advice-remove 'common-lisp-indent-function
    774                    'sly-common-lisp-indent-function)))
    775 
    776 
    777 (defvar sly--lisp-indent-feature-expr-regexp "#!?\\(+\\|-\\)")
    778 
    779 ;;; Semi-feature-expression aware keyword check.
    780 (defun sly--lisp-indent-looking-at-keyword ()
    781   (or (looking-at ":")
    782       (and (looking-at sly--lisp-indent-feature-expr-regexp)
    783            (save-excursion
    784              (forward-sexp)
    785              (skip-chars-forward " \t\n")
    786              (sly--lisp-indent-looking-at-keyword)))))
    787 
    788 ;;; Semi-feature-expression aware backwards movement for keyword
    789 ;;; argument pairs.
    790 (defun sly--lisp-indent-backward-keyword-argument ()
    791   (ignore-errors
    792     (backward-sexp 2)
    793     (when (looking-at sly--lisp-indent-feature-expr-regexp)
    794       (cond ((ignore-errors
    795                (save-excursion
    796                  (backward-sexp 2)
    797                  (looking-at sly--lisp-indent-feature-expr-regexp)))
    798              (sly--lisp-indent-backward-keyword-argument))
    799             ((ignore-errors
    800                (save-excursion
    801                  (backward-sexp 1)
    802                  (looking-at ":")))
    803              (backward-sexp))))
    804     t))
    805 
    806 (defvar sly--lisp-indent-containing-sexp)
    807 
    808 (defun sly--lisp-indent-function-1 (indent-point state)
    809   ;; If we're looking at a splice, move to the first comma.
    810   (when (or (eq (char-before) ?,)
    811             (and (eq (char-before) ?@)
    812                  (eq (char-before (1- (point))) ?,)))
    813     (when (re-search-backward "[^,@'],")
    814       (forward-char 1)))
    815   (let ((normal-indent (current-column)))
    816     ;; Walk up list levels until we see something
    817     ;;  which does special things with subforms.
    818     (let ((depth 0)
    819           ;; Path describes the position of point in terms of
    820           ;;  list-structure with respect to containing lists.
    821           ;; `foo' has a path of (0 3 1) in `((a b c (d foo) f) g)'.
    822           (path ())
    823           ;; set non-nil when somebody works out the indentation to use
    824           calculated
    825           ;; If non-nil, this is an indentation to use
    826           ;; if nothing else specifies it more firmly.
    827           tentative-calculated
    828           ;; (last-point indent-point)
    829           ;; the position of the open-paren of the innermost containing list
    830           (containing-form-start (sly--lisp-indent-parse-state-start state))
    831           ;; the column of the above
    832           sexp-column)
    833       ;; Move to start of innermost containing list
    834       (goto-char containing-form-start)
    835       (setq sexp-column (current-column))
    836 
    837       ;; Look over successively less-deep containing forms
    838       (while (and (not calculated)
    839                   (< depth sly-lisp-indent-maximum-backtracking))
    840         (let ((sly--lisp-indent-containing-sexp (point)))
    841           (forward-char 1)
    842           (parse-partial-sexp (point) indent-point 1 t)
    843           ;; Move to the car of the relevant containing form
    844           (let (tem full function method tentative-defun)
    845             (if (not (looking-at "\\sw\\|\\s_"))
    846                 ;; This form doesn't seem to start with a symbol
    847                 (setq function nil method nil full nil)
    848               (setq tem (point))
    849               (forward-sexp 1)
    850               (setq full (downcase (buffer-substring-no-properties tem (point)))
    851                     function full)
    852               (goto-char tem)
    853               (setq tem (intern-soft function)
    854                     method (sly--lisp-indent-get-indentation tem))
    855               (cond ((and (null method)
    856                           (string-match ":[^:]+" function))
    857                      ;; The pleblisp package feature
    858                      (setq function (substring function (1+ (match-beginning 0)))
    859                            method (sly--lisp-indent-get-indentation
    860                                    (intern-soft function) full)))
    861                     ((and (null method))
    862                      ;; backwards compatibility
    863                      (setq method (sly--lisp-indent-get-indentation tem)))))
    864             (let ((n 0))
    865               ;; How far into the containing form is the current form?
    866               (if (< (point) indent-point)
    867                   (while (ignore-errors
    868                            (forward-sexp 1)
    869                            (if (>= (point) indent-point)
    870                                nil
    871                              (parse-partial-sexp (point)
    872                                                  indent-point 1 t)
    873                              (setq n (1+ n))
    874                              t))))
    875               (setq path (cons n path)))
    876 
    877             ;; Guess.
    878             (when (and (not method) function (null (cdr path)))
    879               ;; (package prefix was stripped off above)
    880               (cond ((and (string-match "\\`def" function)
    881                           (not (string-match "\\`default" function))
    882                           (not (string-match "\\`definition" function))
    883                           (not (string-match "\\`definer" function)))
    884                      (setq tentative-defun t))
    885                     ((string-match
    886                       (eval-when-compile
    887                         (concat "\\`\\("
    888                                 (regexp-opt '("with" "without" "do"))
    889                                 "\\)-"))
    890                       function)
    891                      (setq method '(&lambda &body)))))
    892 
    893             ;; #+ and #- cleverness.
    894             (save-excursion
    895               (goto-char indent-point)
    896               (backward-sexp)
    897               (let ((indent (current-column)))
    898                 (when
    899                     (or (looking-at sly--lisp-indent-feature-expr-regexp)
    900                         (ignore-errors
    901                           (backward-sexp)
    902                           (when (looking-at sly--lisp-indent-feature-expr-regexp)
    903                             (setq indent (current-column))
    904                             (let ((line (line-number-at-pos)))
    905                               (while
    906                                   (ignore-errors
    907                                     (backward-sexp 2)
    908                                     (and (= line (line-number-at-pos))
    909                                          (looking-at sly--lisp-indent-feature-expr-regexp)))
    910                                 (setq indent (current-column))))
    911                             t)))
    912                   (setq calculated (list indent containing-form-start)))))
    913 
    914             (cond ((and (or (eq (char-after (1- sly--lisp-indent-containing-sexp)) ?\')
    915                             (and (not sly-lisp-backquote-indentation)
    916                                  (eq (char-after (1- sly--lisp-indent-containing-sexp)) ?\`)))
    917                         (not (eq (char-after (- sly--lisp-indent-containing-sexp 2)) ?\#)))
    918                    ;; No indentation for "'(...)" elements
    919                    (setq calculated (1+ sexp-column)))
    920                   ((eq (char-after (1- sly--lisp-indent-containing-sexp)) ?\#)
    921                    ;; "#(...)"
    922                    (setq calculated (1+ sexp-column)))
    923                   ((null method)
    924                    ;; If this looks like a call to a `def...' form,
    925                    ;; think about indenting it as one, but do it
    926                    ;; tentatively for cases like
    927                    ;; (flet ((defunp ()
    928                    ;;          nil)))
    929                    ;; Set both normal-indent and tentative-calculated.
    930                    ;; The latter ensures this value gets used
    931                    ;; if there are no relevant containing constructs.
    932                    ;; The former ensures this value gets used
    933                    ;; if there is a relevant containing construct
    934                    ;; but we are nested within the structure levels
    935                    ;; that it specifies indentation for.
    936                    (if tentative-defun
    937                        (setq tentative-calculated
    938                              (sly--lisp-indent-call-method
    939                               function sly-lisp-indent-defun-method
    940                               path state indent-point
    941                               sexp-column normal-indent)
    942                              normal-indent tentative-calculated)
    943                      (when sly-lisp-align-keywords-in-calls
    944                        ;; No method so far. If we're looking at a keyword,
    945                        ;; align with the first keyword in this expression.
    946                        ;; This gives a reasonable indentation to most things
    947                        ;; with keyword arguments.
    948                        (save-excursion
    949                          (goto-char indent-point)
    950                          (back-to-indentation)
    951                          (when (sly--lisp-indent-looking-at-keyword)
    952                            (while (sly--lisp-indent-backward-keyword-argument)
    953                              (when (sly--lisp-indent-looking-at-keyword)
    954                                (setq calculated
    955                                      (list (current-column)
    956                                            containing-form-start)))))))))
    957                   ((integerp method)
    958                    ;; convenient top-level hack.
    959                    ;;  (also compatible with lisp-indent-function)
    960                    ;; The number specifies how many `distinguished'
    961                    ;;  forms there are before the body starts
    962                    ;; Equivalent to (4 4 ... &body)
    963                    (setq calculated (cond ((cdr path) normal-indent)
    964                                           ((<= (car path) method)
    965                                            ;; `distinguished' form
    966                                            (list (+ sexp-column 4)
    967                                                  containing-form-start))
    968                                           ((= (car path) (1+ method))
    969                                            ;; first body form.
    970                                            (+ sexp-column lisp-body-indent))
    971                                           (t
    972                                            ;; other body form
    973                                            normal-indent))))
    974                   (t
    975                    (setq calculated
    976                          (sly--lisp-indent-call-method
    977                           function method path state indent-point
    978                           sexp-column normal-indent)))))
    979           (goto-char sly--lisp-indent-containing-sexp)
    980           ;; (setq last-point sly--lisp-indent-containing-sexp)
    981           (unless calculated
    982             (condition-case ()
    983                 (progn (backward-up-list 1)
    984                        (setq depth (1+ depth)))
    985               (error
    986                (setq depth sly-lisp-indent-maximum-backtracking))))))
    987 
    988       (or calculated tentative-calculated
    989           ;; Fallback.
    990           ;;
    991           ;; Instead of punting directly to calculate-lisp-indent we
    992           ;; handle a few of cases it doesn't deal with:
    993           ;;
    994           ;; A: (foo (
    995           ;;          bar zot
    996           ;;          quux))
    997           ;;
    998           ;;    would align QUUX with ZOT.
    999           ;;
   1000           ;; B:
   1001           ;;   (foo (or x
   1002           ;;            y) t
   1003           ;;        z)
   1004           ;;
   1005           ;;   would align the Z with Y.
   1006           ;;
   1007           ;; C:
   1008           ;;   (foo ;; Comment
   1009           ;;        (bar)
   1010           ;;        ;; Comment 2
   1011           ;;        (quux))
   1012           ;;
   1013           ;;   would indent BAR and QUUX by one.
   1014           (ignore-errors
   1015             (save-excursion
   1016               (goto-char indent-point)
   1017               (back-to-indentation)
   1018               (let ((p (point)))
   1019                 (goto-char containing-form-start)
   1020                 (down-list)
   1021                 (let ((one (current-column)))
   1022                   (skip-chars-forward " \t")
   1023                   (if (or (eolp) (looking-at ";"))
   1024                       ;; A.
   1025                       (list one containing-form-start)
   1026                     (forward-sexp 2)
   1027                     (backward-sexp)
   1028                     (if (/= p (point))
   1029                         ;; B.
   1030                         (list (current-column) containing-form-start)
   1031                       (backward-sexp)
   1032                       (forward-sexp)
   1033                       (let ((tmp (+ (current-column) 1)))
   1034                         (skip-chars-forward " \t")
   1035                         (if (looking-at ";")
   1036                             ;; C.
   1037                             (list tmp containing-form-start)))))))))))))
   1038 
   1039 
   1040 
   1041 ;; Dynamically bound in `sly--lisp-indent-call-method'.
   1042 (defvar sly--lisp-indent-error-function)
   1043 
   1044 (defun sly--lisp-indent-call-method (function method path state indent-point
   1045                                      sexp-column normal-indent)
   1046   (let ((sly--lisp-indent-error-function function))
   1047     (if (symbolp method)
   1048         (funcall method
   1049                  path state indent-point
   1050                  sexp-column normal-indent)
   1051       (sly--lisp-indent-259 method path state indent-point
   1052                             sexp-column normal-indent))))
   1053 
   1054 (defun sly--lisp-indent-report-bad-format (m)
   1055   (error "%s has a badly-formed %s property: %s"
   1056          ;; Love those free variable references!!
   1057          sly--lisp-indent-error-function
   1058          'sly-common-lisp-indent-function m))
   1059 
   1060 
   1061 ;; Lambda-list indentation is now done in `sly--lisp-indent-lambda-list'.
   1062 ;; See also `sly-lisp-lambda-list-keyword-alignment',
   1063 ;; `sly-lisp-lambda-list-keyword-parameter-alignment' and
   1064 ;; `sly-lisp-lambda-list-keyword-parameter-indentation' -- dvl
   1065 
   1066 (defvar sly--lisp-indent-lambda-list-keywords-regexp
   1067   "&\\(\
   1068 optional\\|rest\\|key\\|allow-other-keys\\|aux\\|whole\\|body\\|\
   1069 environment\\|more\
   1070 \\)\\>"
   1071   "Regular expression matching lambda-list keywords.")
   1072 
   1073 (defun sly--lisp-indent-lambda-list
   1074     (indent-point sexp-column containing-form-start)
   1075   (if (not sly-lisp-lambda-list-indentation)
   1076       (1+ sexp-column)
   1077     (sly--lisp-indent-properly-indent-lambda-list
   1078      indent-point sexp-column containing-form-start)))
   1079 
   1080 (defun sly--lisp-indent-properly-indent-lambda-list
   1081     (indent-point sexp-column containing-form-start)
   1082   (cond
   1083     ((save-excursion
   1084        (goto-char indent-point)
   1085        (back-to-indentation)
   1086        (looking-at sly--lisp-indent-lambda-list-keywords-regexp))
   1087      ;; We're facing a lambda-list keyword.
   1088      (if sly-lisp-lambda-list-keyword-alignment
   1089          ;; Align to the first keyword if any, or to the beginning of
   1090          ;; the lambda-list.
   1091          (save-excursion
   1092            (goto-char containing-form-start)
   1093            (down-list)
   1094            (let ((key-indent nil)
   1095                  (next t))
   1096              (while (and next (< (point) indent-point))
   1097                (if (looking-at sly--lisp-indent-lambda-list-keywords-regexp)
   1098                    (setq key-indent (current-column)
   1099                          next nil)
   1100                  (setq next (ignore-errors (forward-sexp) t))
   1101                  (if next
   1102                      (ignore-errors
   1103                        (forward-sexp)
   1104                        (backward-sexp)))))
   1105              (or key-indent
   1106                  (1+ sexp-column))))
   1107        ;; Align to the beginning of the lambda-list.
   1108        (1+ sexp-column)))
   1109     (t
   1110      ;; Otherwise, align to the first argument of the last lambda-list
   1111      ;; keyword, the keyword itself, or the beginning of the
   1112      ;; lambda-list.
   1113      (save-excursion
   1114        (goto-char indent-point)
   1115        (let ((indent nil)
   1116              (next t))
   1117          (while (and next (> (point) containing-form-start))
   1118            (setq next (ignore-errors (backward-sexp) t))
   1119            (let* ((col (current-column))
   1120                   (pos
   1121                    (save-excursion
   1122                      (ignore-errors (forward-sexp))
   1123                      (skip-chars-forward " \t")
   1124                      (if (eolp)
   1125                          (+ col sly-lisp-lambda-list-keyword-parameter-indentation)
   1126                        col))))
   1127              (if (looking-at sly--lisp-indent-lambda-list-keywords-regexp)
   1128                  (setq indent
   1129                        (if sly-lisp-lambda-list-keyword-parameter-alignment
   1130                            (or indent pos)
   1131                          (+ col sly-lisp-lambda-list-keyword-parameter-indentation))
   1132                        next nil)
   1133                (setq indent col))))
   1134          (or indent (1+ sexp-column)))))))
   1135 
   1136 (defun sly--lisp-indent-lambda-list-initial-value-form-p (point)
   1137   (let ((state 'x)
   1138         (point (save-excursion
   1139                  (goto-char point)
   1140                  (back-to-indentation)
   1141                  (point))))
   1142     (save-excursion
   1143       (backward-sexp)
   1144       (ignore-errors (down-list 1))
   1145       (while (and point (< (point) point))
   1146         (cond ((looking-at "&\\(key\\|optional\\|aux\\)")
   1147                (setq state 'key))
   1148               ((looking-at sly--lisp-indent-lambda-list-keywords-regexp)
   1149                (setq state 'x)))
   1150         (if (not (ignore-errors (forward-sexp) t))
   1151             (setq point nil)
   1152           (ignore-errors
   1153             (forward-sexp)
   1154             (backward-sexp))
   1155           (cond ((> (point) point)
   1156                  (backward-sexp)
   1157                  (when (eq state 'var)
   1158                    (setq state 'x))
   1159                  (or (ignore-errors
   1160                        (down-list 1)
   1161                        (cond ((> (point) point)
   1162                               (backward-up-list))
   1163                              ((eq 'key state)
   1164                               (setq state 'var)))
   1165                        t)
   1166                      (setq point nil)))
   1167                 ((eq state 'var)
   1168                  (setq state 'form))))))
   1169     (eq 'form state)))
   1170 
   1171 ;; Blame the crufty control structure on dynamic scoping
   1172 ;;  -- not on me!
   1173 (defun sly--lisp-indent-259
   1174     (method path state indent-point sexp-column normal-indent)
   1175   (catch 'exit
   1176     (let* ((p (cdr path))
   1177            (containing-form-start (elt state 1))
   1178            (n (1- (car path)))
   1179            tem tail)
   1180       (if (not (consp method))
   1181           (sly--lisp-indent-report-bad-format method))
   1182       (while n
   1183         ;; This while loop is for advancing along a method
   1184         ;; until the relevant (possibly &rest/&body) pattern
   1185         ;; is reached.
   1186         ;; n is set to (1- n) and method to (cdr method)
   1187         ;; each iteration.
   1188         (setq tem (car method))
   1189 
   1190         (or (eq tem 'nil)             ;default indentation
   1191             (eq tem '&lambda)         ;lambda list
   1192             (and (eq tem '&body) (null (cdr method)))
   1193             (and (eq tem '&rest)
   1194                  (consp (cdr method))
   1195                  (null (cddr method)))
   1196             (integerp tem)            ;explicit indentation specified
   1197             (and (consp tem)          ;destructuring
   1198                  (or (consp (car tem))
   1199                      (and (eq (car tem) '&whole)
   1200                           (or (symbolp (cadr tem))
   1201                               (integerp (cadr tem))))))
   1202             (and (symbolp tem)        ;a function to call to do the work.
   1203                  (null (cdr method)))
   1204             (sly--lisp-indent-report-bad-format method))
   1205         (cond ((eq tem '&body)
   1206                ;; &body means (&rest <lisp-body-indent>)
   1207                (throw 'exit
   1208                       (if (null p)
   1209                           (+ sexp-column lisp-body-indent)
   1210                         normal-indent)))
   1211               ((eq tem '&rest)
   1212                ;; this pattern holds for all remaining forms
   1213                (setq tail (> n 0)
   1214                      n 0
   1215                      method (cdr method)))
   1216               ((> n 0)
   1217                ;; try next element of pattern
   1218                (setq n (1- n)
   1219                      method (cdr method))
   1220                (if (< n 0)
   1221                    ;; Too few elements in pattern.
   1222                    (throw 'exit normal-indent)))
   1223               ((eq tem 'nil)
   1224                (throw 'exit (if (consp normal-indent)
   1225                                 normal-indent
   1226                               (list normal-indent containing-form-start))))
   1227               ((eq tem '&lambda)
   1228                (throw 'exit
   1229                       (cond ((not (eq (char-before) ?\)))
   1230                              ;; If it's not a list at all, indent it
   1231                              ;; like body instead.
   1232                              (if (null p)
   1233                                  (+ sexp-column lisp-body-indent)
   1234                                normal-indent))
   1235                             ((sly--lisp-indent-lambda-list-initial-value-form-p indent-point)
   1236                              (if (consp normal-indent)
   1237                                  normal-indent
   1238                                (list normal-indent containing-form-start)))
   1239                             ((null p)
   1240                              (list (+ sexp-column 4) containing-form-start))
   1241                             (t
   1242                              ;; Indentation within a lambda-list. -- dvl
   1243                              (list (sly--lisp-indent-lambda-list
   1244                                     indent-point
   1245                                     sexp-column
   1246                                     containing-form-start)
   1247                                    containing-form-start)))))
   1248               ((integerp tem)
   1249                (throw 'exit
   1250                       (if (null p)         ;not in subforms
   1251                           (list (+ sexp-column tem) containing-form-start)
   1252                         normal-indent)))
   1253               ((symbolp tem)          ;a function to call
   1254                (throw 'exit
   1255                       (funcall tem path state indent-point
   1256                                sexp-column normal-indent)))
   1257               (t
   1258                ;; must be a destructing frob
   1259                (if p
   1260                    ;; descend
   1261                    (setq method (cddr tem)
   1262                          n (car p)
   1263                          p (cdr p)
   1264                          tail nil)
   1265                  (let ((wholep (eq '&whole (car tem))))
   1266                    (setq tem (cadr tem))
   1267                    (throw 'exit
   1268                           (cond (tail
   1269                                  (if (and wholep (integerp tem)
   1270                                           (save-excursion
   1271                                             (goto-char indent-point)
   1272                                             (back-to-indentation)
   1273                                             (looking-at "\\sw")))
   1274                                      ;; There's a further level of
   1275                                      ;; destructuring, but we're looking at a
   1276                                      ;; word -- indent to sexp.
   1277                                      (+ sexp-column tem)
   1278                                    normal-indent))
   1279                                 ((not tem)
   1280                                  (list normal-indent
   1281                                        containing-form-start))
   1282                                 ((integerp tem)
   1283                                  (list (+ sexp-column tem)
   1284                                        containing-form-start))
   1285                                 (t
   1286                                  (funcall tem path state indent-point
   1287                                           sexp-column normal-indent))))))))))))
   1288 
   1289 (defun sly--lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
   1290   (if (cdr path)
   1291       normal-indent
   1292     (save-excursion
   1293       (goto-char indent-point)
   1294       (back-to-indentation)
   1295       (list (cond ((looking-at "\\sw\\|\\s_")
   1296                    ;; a tagbody tag
   1297                    (+ sexp-column sly-lisp-tag-indentation))
   1298                   ((integerp sly-lisp-tag-body-indentation)
   1299                    (+ sexp-column sly-lisp-tag-body-indentation))
   1300                   ((eq sly-lisp-tag-body-indentation 't)
   1301                    (condition-case ()
   1302                        (progn (backward-sexp 1) (current-column))
   1303                      (error (1+ sexp-column))))
   1304                   (t (+ sexp-column lisp-body-indent)))
   1305             (nth 1 state)))))
   1306 
   1307 (defun sly--lisp-indent-do (path state indent-point sexp-column normal-indent)
   1308   (if (>= (car path) 3)
   1309       (let ((sly-lisp-tag-body-indentation lisp-body-indent))
   1310         (sly--lisp-indent-tagbody
   1311          path state indent-point sexp-column normal-indent))
   1312     (sly--lisp-indent-259
   1313      '((&whole nil &rest
   1314         ;; the following causes weird indentation
   1315         ;;(&whole 1 1 2 nil)
   1316         )
   1317        (&whole nil &rest 1))
   1318      path state indent-point sexp-column normal-indent)))
   1319 
   1320 (defun sly--lisp-indent-defsetf
   1321     (path state indent-point sexp-column normal-indent)
   1322   (ignore normal-indent)
   1323   (let ((form-start (nth 1 state)))
   1324     (list
   1325      (cond
   1326        ;; Inside the lambda-list in a long-form defsetf.
   1327        ((and (eq 2 (car path)) (cdr path))
   1328         (sly--lisp-indent-lambda-list indent-point sexp-column form-start))
   1329        ;; Long form: has a lambda-list.
   1330        ((or (cdr path)
   1331             (save-excursion
   1332               (goto-char form-start)
   1333               (ignore-errors
   1334                 (down-list)
   1335                 (forward-sexp 3)
   1336                 (backward-sexp)
   1337                 (looking-at "nil\\|("))))
   1338         (+ sexp-column (if (<= 1 (car path) 3) 4 2)))
   1339        ;; Short form.
   1340        (t (+ sexp-column (if (<= 1 (car path) 2) 4 2))))
   1341      form-start)))
   1342 
   1343 (defun sly--lisp-indent-beginning-of-defmethod-qualifiers ()
   1344   (let ((case-fold-search t)
   1345         (regexp "(\\(?:\\(def\\)\\|\\(:\\)\\)method"))
   1346     (ignore-errors
   1347       (while (not (looking-at regexp)) (backward-up-list))
   1348       (cond ((match-string 1)
   1349              (forward-char)
   1350              ;; Skip name.
   1351              (forward-sexp 2)
   1352              1)
   1353             ((match-string 2)
   1354              (forward-char)
   1355              (forward-sexp 1)
   1356              0)))))
   1357 
   1358 ;; LISP-INDENT-DEFMETHOD now supports the presence of more than one method
   1359 ;; qualifier and indents the method's lambda list properly. -- dvl
   1360 (defun sly--lisp-indent-defmethod
   1361     (path state indent-point sexp-column normal-indent)
   1362   (sly--lisp-indent-259
   1363    (let ((nskip nil))
   1364      (if (save-excursion
   1365            (when (setq nskip (sly--lisp-indent-beginning-of-defmethod-qualifiers))
   1366              (skip-chars-forward " \t\n")
   1367              (while (looking-at "\\sw\\|\\s_")
   1368                (cl-incf nskip)
   1369                (forward-sexp)
   1370                (skip-chars-forward " \t\n"))
   1371              t))
   1372          (nconc (make-list nskip 4) '(&lambda &body))
   1373        (sly--lisp-indent-get-indentation 'defun)))
   1374    path state indent-point sexp-column normal-indent))
   1375 
   1376 (defun sly--lisp-indent-function-lambda-hack (path state indent-point
   1377                                               sexp-column normal-indent)
   1378   (ignore indent-point state)
   1379   ;; indent (function (lambda () <newline> <body-forms>)) kludgily.
   1380   (if (or (cdr path) ; wtf?
   1381           (> (car path) 3))
   1382       ;; line up under previous body form
   1383       normal-indent
   1384     ;; line up under function rather than under lambda in order to
   1385     ;;  conserve horizontal space.  (Which is what #' is for.)
   1386     (condition-case ()
   1387         (save-excursion
   1388           (backward-up-list 2)
   1389           (forward-char 1)
   1390           (if (looking-at "\\(\\(common-lisp\\|cl\\)::?\\)?function\\(\\Sw\\|\\S_\\)")
   1391               (+ lisp-body-indent -1 (current-column))
   1392             (+ sexp-column lisp-body-indent)))
   1393       (error (+ sexp-column lisp-body-indent)))))
   1394 
   1395 (defun sly--lisp-indent-loop (path state indent-point sexp-column normal-indent)
   1396   (ignore sexp-column)
   1397   (if (cdr path)
   1398       normal-indent
   1399     (let* ((loop-start (elt state 1))
   1400            (type (sly--lisp-indent-loop-type loop-start)))
   1401       (cond ((and sly-lisp-loop-indent-subclauses
   1402                   (memq type '(extended extended/split)))
   1403              (list (sly--lisp-indent-loop-macro-1 state indent-point)
   1404                    (sly--lisp-indent-parse-state-start state)))
   1405             (t
   1406              (sly--lisp-indent-loop-part-indentation indent-point state type))))))
   1407 
   1408 ;;;; LOOP indentation, the complex version -- handles subclause indentation
   1409 
   1410 ;; Regexps matching various varieties of loop macro keyword ...
   1411 (defvar sly--common-lisp-body-introducing-loop-macro-keyword
   1412   (concat "\\(?:\\_<\\|#?:\\)"
   1413           (regexp-opt '("do" "doing" "finally" "initially"))
   1414           "\\_>")
   1415   "Regexp matching loop macro keywords which introduce body forms.")
   1416 
   1417 ;; Not currently used
   1418 (defvar sly--common-lisp-accumulation-loop-macro-keyword
   1419   (concat "\\(?:\\_<\\|#?:\\)"
   1420           (regexp-opt '("collect" "collecting"
   1421                         "append" "appending"
   1422                         "nconc" "nconcing"
   1423                         "sum" "summing"
   1424                         "count" "counting"
   1425                         "maximize" "maximizing"
   1426                         "minimize" "minimizing"))
   1427           "\\_>")
   1428   "Regexp matching loop macro keywords which introduce accumulation clauses.")
   1429 
   1430 ;; This is so "and when" and "else when" get handled right
   1431 ;; (not to mention "else do" !!!)
   1432 (defvar sly--common-lisp-prefix-loop-macro-keyword
   1433   (concat "\\(?:\\_<\\|#?:\\)" (regexp-opt '("and" "else")) "\\_>")
   1434   "Regexp matching loop macro keywords which are prefixes.")
   1435 
   1436 (defvar sly--common-lisp-indent-clause-joining-loop-macro-keyword
   1437   "\\(?:\\_<\\|#?:\\)and\\_>"
   1438   "Regexp matching 'and', and anything else there ever comes to be like it.")
   1439 
   1440 (defvar sly--common-lisp-indent-indented-loop-macro-keyword
   1441   (concat "\\(?:\\_<\\|#?:\\)"
   1442           (regexp-opt '("upfrom" "downfrom" "upto" "downto" "below" "above"
   1443                         "into" "in" "on" "by" "from" "to" "by" "across" "being"
   1444                         "each" "the" "then" "hash-key" "hash-keys" "hash-value"
   1445                         "hash-values" "present-symbol" "present-symbols"
   1446                         "external-symbol" "external-symbols" "using" "symbol"
   1447                         "symbols" "float" "fixnum" "t" "nil" "of-type" "of" "="))
   1448           "\\_>")
   1449   "Regexp matching keywords introducing loop subclauses.
   1450 Always indented two.")
   1451 
   1452 (defvar sly--common-lisp-indenting-loop-macro-keyword
   1453   (concat "\\(?:\\_<\\|#?:\\)" (regexp-opt '("when" "unless" "if")) "\\_>")
   1454   "Regexp matching keywords introducing conditional clauses.
   1455 Cause subsequent clauses to be indented.")
   1456 
   1457 (defvar sly--lisp-indent-loop-macro-else-keyword
   1458   "\\(?:\\_<\\|#?:\\)else\\_>")
   1459 
   1460 ;;; Attempt to indent the loop macro ...
   1461 (defun sly--lisp-indent-loop-part-indentation (indent-point state type)
   1462   "Compute the indentation of loop form constituents."
   1463   (let* ((loop-start (nth 1 state))
   1464          (loop-indentation (save-excursion
   1465                              (goto-char loop-start)
   1466                              (if (eq type 'extended/split)
   1467                                  (- (current-column) 4)
   1468                                (current-column))))
   1469          (indent nil)
   1470          (re "\\(\\(#?:\\)?\\sw+\\|)\\|\n\\)"))
   1471     (goto-char indent-point)
   1472     (back-to-indentation)
   1473     (cond ((eq type 'simple/split)
   1474            (+ loop-indentation sly-lisp-simple-loop-indentation))
   1475           ((eq type 'simple)
   1476            (+ loop-indentation 6))
   1477           ;; We are already in a body, with forms in it.
   1478           ((and (not (looking-at re))
   1479                 (save-excursion
   1480                   (while (and (ignore-errors (backward-sexp) t)
   1481                               (not (looking-at re)))
   1482                     (setq indent (current-column)))
   1483                   (and indent
   1484                        (looking-at sly--common-lisp-body-introducing-loop-macro-keyword))))
   1485            (list indent loop-start))
   1486           ;; Keyword-style or comment outside body
   1487           ((or sly-lisp-loop-indent-forms-like-keywords
   1488                (looking-at re)
   1489                (looking-at ";"))
   1490            (if (and (looking-at ";")
   1491                     (let ((p (sly--lisp-indent-trailing-comment)))
   1492                       (when p
   1493                         (setq loop-indentation p))))
   1494                (list loop-indentation loop-start)
   1495              (list (+ loop-indentation 6) loop-start)))
   1496           ;; Form-style
   1497           (t
   1498            (list (+ loop-indentation 9) loop-start)))))
   1499 
   1500 (defun sly--lisp-indent-loop-advance-past-keyword-on-line ()
   1501   (forward-word 1)
   1502   (while (and (looking-at "\\s-") (not (eolp)))
   1503     (forward-char 1))
   1504   (unless (eolp)
   1505     (current-column)))
   1506 
   1507 (defun sly--lisp-indent-loop-macro-1 (parse-state indent-point)
   1508   (catch 'return-indentation
   1509     (save-excursion
   1510       ;; Find first clause of loop macro, and use it to establish
   1511       ;; base column for indentation
   1512       (goto-char (sly--lisp-indent-parse-state-start parse-state))
   1513       (let ((loop-start-column (current-column)))
   1514         (sly--lisp-indent-loop-advance-past-keyword-on-line)
   1515 
   1516         (when (eolp)
   1517           (forward-line 1)
   1518           (end-of-line)
   1519           ;; If indenting first line after "(loop <newline>"
   1520           ;; cop out ...
   1521           (if (<= indent-point (point))
   1522               (throw 'return-indentation
   1523                      (+ loop-start-column
   1524                         sly-lisp-loop-clauses-indentation)))
   1525           (back-to-indentation))
   1526 
   1527         (let* ((case-fold-search t)
   1528                (loop-macro-first-clause (point))
   1529                (previous-expression-start
   1530                 (sly--lisp-indent-parse-state-prev parse-state))
   1531                (default-value (current-column))
   1532                (loop-body-p nil)
   1533                (loop-body-indentation nil)
   1534                (indented-clause-indentation (+ 2 default-value)))
   1535           ;; Determine context of this loop clause, starting with the
   1536           ;; expression immediately preceding the line we're trying to indent
   1537           (goto-char previous-expression-start)
   1538 
   1539           ;; Handle a body-introducing-clause which ends a line specially.
   1540           (if (looking-at sly--common-lisp-body-introducing-loop-macro-keyword)
   1541               (let ((keyword-position (current-column)))
   1542                 (setq loop-body-p t)
   1543                 (setq loop-body-indentation
   1544                       (if (sly--lisp-indent-loop-advance-past-keyword-on-line)
   1545                           (current-column)
   1546                         (back-to-indentation)
   1547                         (if (/= (current-column) keyword-position)
   1548                             (+ 2 (current-column))
   1549                           (+ sly-lisp-loop-body-forms-indentation
   1550                              (if sly-lisp-loop-indent-body-forms-relative-to-loop-start
   1551                                  loop-start-column
   1552                                keyword-position))))))
   1553 
   1554             (back-to-indentation)
   1555             (if (< (point) loop-macro-first-clause)
   1556                 (goto-char loop-macro-first-clause))
   1557             ;; If there's an "and" or "else," advance over it.
   1558             ;; If it is alone on the line, the next "cond" will treat it
   1559             ;; as if there were a "when" and indent under it ...
   1560             (let ((exit nil))
   1561               (while (and (null exit)
   1562                           (looking-at sly--common-lisp-prefix-loop-macro-keyword))
   1563                 (if (null (sly--lisp-indent-loop-advance-past-keyword-on-line))
   1564                     (progn (setq exit t)
   1565                            (back-to-indentation)))))
   1566 
   1567             ;; Found start of loop clause preceding the one we're
   1568             ;; trying to indent. Glean context ...
   1569             (cond
   1570              ((looking-at "(")
   1571               ;; We're in the middle of a clause body ...
   1572               (setq loop-body-p t)
   1573               (setq loop-body-indentation (current-column)))
   1574              ((looking-at sly--common-lisp-body-introducing-loop-macro-keyword)
   1575               (setq loop-body-p t)
   1576               ;; Know there's something else on the line (or would
   1577               ;; have been caught above)
   1578               (sly--lisp-indent-loop-advance-past-keyword-on-line)
   1579               (setq loop-body-indentation (current-column)))
   1580              (t
   1581               (setq loop-body-p nil)
   1582               (if (or (looking-at sly--common-lisp-indenting-loop-macro-keyword)
   1583                       (looking-at sly--common-lisp-prefix-loop-macro-keyword))
   1584                   (setq default-value (+ 2 (current-column))))
   1585               (setq indented-clause-indentation (+ 2 (current-column)))
   1586               ;; We still need loop-body-indentation for "syntax errors" ...
   1587               (goto-char previous-expression-start)
   1588               (setq loop-body-indentation (current-column)))))
   1589 
   1590           ;; Go to first non-blank character of the line we're trying
   1591           ;; to indent. (if none, wind up poised on the new-line ...)
   1592           (goto-char indent-point)
   1593           (back-to-indentation)
   1594           (cond
   1595            ((looking-at "(")
   1596             ;; Clause body ...
   1597             loop-body-indentation)
   1598            ((or (eolp) (looking-at ";"))
   1599             ;; Blank line.  If body-p, indent as body, else indent as
   1600             ;; vanilla clause.
   1601             (if loop-body-p
   1602                 loop-body-indentation
   1603               (or (and (looking-at ";") (sly--lisp-indent-trailing-comment))
   1604                   default-value)))
   1605            ((looking-at sly--common-lisp-indent-indented-loop-macro-keyword)
   1606             indented-clause-indentation)
   1607            ((looking-at sly--common-lisp-indent-clause-joining-loop-macro-keyword)
   1608             (let ((stolen-indent-column nil))
   1609               (forward-line -1)
   1610               (while (and (null stolen-indent-column)
   1611                           (> (point) loop-macro-first-clause))
   1612                 (back-to-indentation)
   1613                 (if (and (< (current-column) loop-body-indentation)
   1614                          (looking-at "\\(#?:\\)?\\sw"))
   1615                     (progn
   1616                       (if (looking-at sly--lisp-indent-loop-macro-else-keyword)
   1617                           (sly--lisp-indent-loop-advance-past-keyword-on-line))
   1618                       (setq stolen-indent-column (current-column)))
   1619                   (forward-line -1)))
   1620               (or stolen-indent-column default-value)))
   1621            (t default-value)))))))
   1622 
   1623 (defalias 'sly--lisp-indent-if*-advance-past-keyword-on-line
   1624   #'sly--lisp-indent-loop-advance-past-keyword-on-line)
   1625 
   1626 ;;;; IF* is not standard, but a plague upon the land
   1627 ;;;; ...let's at least try to indent it.
   1628 
   1629 (defvar sly--lisp-indent-if*-keyword
   1630   "thenret\\|elseif\\|then\\|else"
   1631   "Regexp matching if* keywords")
   1632 
   1633 (defun sly--lisp-indent-if*
   1634     (path parse-state indent-point sexp-column normal-indent)
   1635   (ignore normal-indent path sexp-column)
   1636   (list (sly--lisp-indent-if*-1 parse-state indent-point)
   1637         (sly--lisp-indent-parse-state-start parse-state)))
   1638 
   1639 (defun sly--lisp-indent-if*-1 (parse-state indent-point)
   1640   (catch 'return-indentation
   1641     (save-excursion
   1642       ;; Find first clause of if* macro, and use it to establish
   1643       ;; base column for indentation
   1644       (goto-char (sly--lisp-indent-parse-state-start parse-state))
   1645       (let ((if*-start-column (current-column)))
   1646         (sly--lisp-indent-if*-advance-past-keyword-on-line)
   1647         (let* ((case-fold-search t)
   1648                (if*-first-clause (point))
   1649                (previous-expression-start
   1650                 (sly--lisp-indent-parse-state-prev parse-state))
   1651                (default-value (current-column))
   1652                (if*-body-p nil)
   1653                (if*-body-indentation nil))
   1654           ;; Determine context of this if* clause, starting with the
   1655           ;; expression immediately preceding the line we're trying to indent
   1656           (goto-char previous-expression-start)
   1657           ;; Handle a body-introducing-clause which ends a line specially.
   1658           (back-to-indentation)
   1659           (if (< (point) if*-first-clause)
   1660               (goto-char if*-first-clause))
   1661           ;; Found start of if* clause preceding the one we're trying
   1662           ;; to indent. Glean context ...
   1663           (cond
   1664             ((looking-at sly--lisp-indent-if*-keyword)
   1665              (setq if*-body-p t)
   1666              ;; Know there's something else on the line (or would
   1667              ;; have been caught above)
   1668              (sly--lisp-indent-if*-advance-past-keyword-on-line)
   1669              (setq if*-body-indentation (current-column)))
   1670             ((looking-at "#'\\|'\\|(")
   1671              ;; We're in the middle of a clause body ...
   1672              (setq if*-body-p t)
   1673              (setq if*-body-indentation (current-column)))
   1674             (t
   1675              (setq if*-body-p nil)
   1676              ;; We still need if*-body-indentation for "syntax errors" ...
   1677              (goto-char previous-expression-start)
   1678              (setq if*-body-indentation (current-column))))
   1679 
   1680           ;; Go to first non-blank character of the line we're trying
   1681           ;; to indent. (if none, wind up poised on the new-line ...)
   1682           (goto-char indent-point)
   1683           (back-to-indentation)
   1684           (cond
   1685             ((or (eolp) (looking-at ";"))
   1686              ;; Blank line.  If body-p, indent as body, else indent as
   1687              ;; vanilla clause.
   1688              (if if*-body-p
   1689                  if*-body-indentation
   1690                default-value))
   1691             ((not (looking-at sly--lisp-indent-if*-keyword))
   1692              ;; Clause body ...
   1693              if*-body-indentation)
   1694             (t (- (+ 7 if*-start-column)
   1695                   (- (match-end 0) (match-beginning 0))))))))))
   1696 
   1697 
   1698 ;;;; Indentation specs for standard symbols, and a few semistandard ones.
   1699 (defun sly--lisp-indent-init-standard-indentation ()
   1700   (let ((l '((block 1)
   1701              (case (4 &rest (&whole 2 &rest 1)))
   1702              (ccase (as case))
   1703              (ecase (as case))
   1704              (typecase (as case))
   1705              (etypecase (as case))
   1706              (ctypecase (as case))
   1707              (catch 1)
   1708              (cond (&rest (&whole 2 &rest nil)))
   1709              ;; for DEFSTRUCT
   1710              (:constructor (4 &lambda))
   1711              (defvar (4 2 2))
   1712              (defclass (6 (&whole 4 &rest 1)
   1713                           (&whole 2 &rest 1)
   1714                           (&whole 2 &rest 1)))
   1715              (defconstant (as defvar))
   1716              (defcustom (4 2 2 2))
   1717              (defparameter (as defvar))
   1718              (defconst (as defcustom))
   1719              (define-condition (as defclass))
   1720              (define-modify-macro (4 &lambda &body))
   1721              (defsetf sly--lisp-indent-defsetf)
   1722              (defun (4 &lambda &body))
   1723              (defgeneric (4 &lambda &body))
   1724              (define-setf-method (as defun))
   1725              (define-setf-expander (as defun))
   1726              (defmacro (as defun))
   1727              (defsubst (as defun))
   1728              (deftype (as defun))
   1729              (defmethod sly--lisp-indent-defmethod)
   1730              (defpackage (4 2))
   1731              (defstruct ((&whole 4 &rest (&whole 2 &rest 1))
   1732                           &rest (&whole 2 &rest 1)))
   1733              (destructuring-bind (&lambda 4 &body))
   1734              (do sly--lisp-indent-do)
   1735              (do* (as do))
   1736              (dolist ((&whole 4 2 1) &body))
   1737              (dotimes (as dolist))
   1738              (eval-when 1)
   1739              (flet ((&whole 4 &rest (&whole 1 4 &lambda &body)) &body))
   1740              (labels (as flet))
   1741              (macrolet (as flet))
   1742              (generic-flet (as flet))
   1743              (generic-labels (as flet))
   1744              (handler-case (4 &rest (&whole 2 &lambda &body)))
   1745              (restart-case (as handler-case))
   1746              ;; single-else style (then and else equally indented)
   1747              (if (&rest nil))
   1748              (if* sly--lisp-indent-if*)
   1749              (lambda (&lambda &rest sly--lisp-indent-function-lambda-hack))
   1750              (let ((&whole 4 &rest (&whole 1 1 2)) &body))
   1751              (let* (as let))
   1752              (compiler-let (as let))
   1753              (handler-bind (as let))
   1754              (restart-bind (as let))
   1755              (locally 1)
   1756              (loop sly--lisp-indent-loop)
   1757              (:method sly--lisp-indent-defmethod) ; in `defgeneric'
   1758              (multiple-value-bind ((&whole 6 &rest 1) 4 &body))
   1759              (multiple-value-call (4 &body))
   1760              (multiple-value-prog1 1)
   1761              (multiple-value-setq (4 2))
   1762              (multiple-value-setf (as multiple-value-setq))
   1763              (named-lambda (4 &lambda &rest sly--lisp-indent-function-lambda-hack))
   1764              (pprint-logical-block (4 2))
   1765              (print-unreadable-object ((&whole 4 1 &rest 1) &body))
   1766              ;; Combines the worst features of BLOCK, LET and TAGBODY
   1767              (prog (&lambda &rest sly--lisp-indent-tagbody))
   1768              (prog* (as prog))
   1769              (prog1 1)
   1770              (prog2 2)
   1771              (progn 0)
   1772              (progv (4 4 &body))
   1773              (return 0)
   1774              (return-from (nil &body))
   1775              (symbol-macrolet (as let))
   1776              (tagbody sly--lisp-indent-tagbody)
   1777              (throw 1)
   1778              (unless 1)
   1779              (unwind-protect (5 &body))
   1780              (when 1)
   1781              (with-slots (as multiple-value-bind))
   1782              (with-accessors (as multiple-value-bind))
   1783              (with-condition-restarts (as multiple-value-bind))
   1784              (with-compilation-unit ((&whole 4 &rest 1) &body))
   1785              (with-output-to-string (4 2))
   1786              (with-standard-io-syntax (2)))))
   1787     (dolist (el l)
   1788       (let* ((name (car el))
   1789              (indentation (cadr el)))
   1790         (put name 'sly-common-lisp-indent-function indentation)))))
   1791 
   1792 (sly--lisp-indent-init-standard-indentation)
   1793 
   1794 (provide 'sly-cl-indent)
   1795 
   1796 ;;; sly-cl-indent.el ends here