Improve semantic indentation rules to be more consistent with cljfmt

rrudakov · rrudakov · commit eb6841ee4ac2 · 2025-03-26T14:41:11.000+01:00
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -10,6 +10,7 @@
   - Highlight named lambda functions properly.
   - Fix syntax highlighting for functions and vars with metadata on the previous
     line.
+- Improve semantic indentation rules to be more consistent with cljfmt.
 
 ## 0.2.3 (2025-03-04)
 
diff --git a/README.md b/README.md
@@ -170,6 +170,20 @@ Set the var `clojure-ts-indent-style` to change it.
 >
 > You can find [this article](https://metaredux.com/posts/2020/12/06/semantic-clojure-formatting.html) comparing semantic and fixed indentation useful.
 
+#### Customizing semantic indentation
+
+You can customize how body of different forms is indented. There is a set of
+default rules, which are aligned with cljfmt indent rules, but you can also set
+custom rules as:
+
+```emacs-lisp
+(setopt clojure-ts-semantic-indent-rules '(("are" . (:block 1))))
+```
+
+Custom rules have higher priority, so default rules can be overridden. Unlike
+cljfmt `clojure-ts-mode` does not support nested rules (it's handled
+differently).
+
 ### Font Locking
 
 To highlight entire rich `comment` expression with the comment font face, set
diff --git a/clojure-ts-mode.el b/clojure-ts-mode.el
@@ -125,6 +125,22 @@ double quotes on the third column."
   :type 'boolean
   :package-version '(clojure-ts-mode . "0.2.4"))
 
+(defcustom clojure-ts-semantic-indent-rules nil
+  "Custom rules to extend default indentation rules for `semantic' style.
+
+Each rule is an alist entry which looks like `(\"symbol-name\"
+. (rule-type rule-value))', where rule-type is one either `:block' or
+`:inner' and rule-value is an integer.  The semantic is similar to
+cljfmt indentation rules.
+
+Default set of rules is defined in
+`clojure-ts--semantic-indent-rules-defaults'."
+  :type '(alist :key-type string
+                :value-type (list (choice (const :tag "Block indentation rule" :block)
+                                          (const :tag "Inner indentation rule" :inner))
+                                  integer))
+  :package-version '(clojure-ts-mode . "0.2.4"))
+
 (defvar clojure-ts-mode-remappings
   '((clojure-mode . clojure-ts-mode)
     (clojurescript-mode . clojure-ts-clojurescript-mode)
@@ -182,7 +198,6 @@ Only intended for use at development time.")
     table)
   "Syntax table for `clojure-ts-mode'.")
 
-
 (defconst clojure-ts--builtin-dynamic-var-regexp
   (eval-and-compile
     (concat "^"
@@ -746,34 +761,129 @@ The possible values for this variable are
      ((parent-is "list_lit") parent 1)
      ((parent-is "set_lit") parent 2))))
 
-(defvar clojure-ts--symbols-with-body-expressions-regexp
-  (eval-and-compile
-    (rx (or
-         ;; Match def* symbols,
-         ;; we also explicitly do not match symbols beginning with
-         ;; "default" "deflate" and "defer", like cljfmt
-         (and line-start "def")
-         ;; Match with-* symbols
-         (and line-start "with-")
-         ;; Exact matches
-         (and line-start
-              (or "alt!" "alt!!" "are" "as->"
-                  "binding" "bound-fn"
-                  "case" "catch" "comment" "cond" "condp" "cond->" "cond->>"
-                  "delay" "do" "doseq" "dotimes" "doto"
-                  "extend" "extend-protocol" "extend-type"
-                  "fdef" "finally" "fn" "for" "future"
-                  "go" "go-loop"
-                  "if" "if-let" "if-not" "if-some"
-                  "let" "letfn" "locking" "loop"
-                  "match" "ns" "proxy" "reify" "struct-map"
-                  "testing" "thread" "try"
-                  "use-fixtures"
-                  "when" "when-first" "when-let" "when-not" "when-some" "while")
-              line-end))))
-  "A regex to match symbols that are functions/macros with a body argument.
-Taken from cljfmt:
-https://github.com/weavejester/cljfmt/blob/fb26b22f569724b05c93eb2502592dfc2de898c3/cljfmt/resources/cljfmt/indents/clojure.clj")
+(defvar clojure-ts--semantic-indent-rules-defaults
+  '(("alt!"            . (:block 0))
+    ("alt!!"           . (:block 0))
+    ("comment"         . (:block 0))
+    ("cond"            . (:block 0))
+    ("delay"           . (:block 0))
+    ("do"              . (:block 0))
+    ("finally"         . (:block 0))
+    ("future"          . (:block 0))
+    ("go"              . (:block 0))
+    ("thread"          . (:block 0))
+    ("try"             . (:block 0))
+    ("with-out-str"    . (:block 0))
+    ("defprotocol"     . (:block 1))
+    ("binding"         . (:block 1))
+    ("defprotocol"     . (:block 1))
+    ("binding"         . (:block 1))
+    ("case"            . (:block 1))
+    ("cond->"          . (:block 1))
+    ("cond->>"         . (:block 1))
+    ("doseq"           . (:block 1))
+    ("dotimes"         . (:block 1))
+    ("doto"            . (:block 1))
+    ("extend"          . (:block 1))
+    ("extend-protocol" . (:block 1))
+    ("extend-type"     . (:block 1))
+    ("for"             . (:block 1))
+    ("go-loop"         . (:block 1))
+    ("if"              . (:block 1))
+    ("if-let"          . (:block 1))
+    ("if-not"          . (:block 1))
+    ("if-some"         . (:block 1))
+    ("let"             . (:block 1))
+    ("letfn"           . (:block 1))
+    ("locking"         . (:block 1))
+    ("loop"            . (:block 1))
+    ("match"           . (:block 1))
+    ("ns"              . (:block 1))
+    ("struct-map"      . (:block 1))
+    ("testing"         . (:block 1))
+    ("when"            . (:block 1))
+    ("when-first"      . (:block 1))
+    ("when-let"        . (:block 1))
+    ("when-not"        . (:block 1))
+    ("when-some"       . (:block 1))
+    ("while"           . (:block 1))
+    ("with-local-vars" . (:block 1))
+    ("with-open"       . (:block 1))
+    ("with-precision"  . (:block 1))
+    ("with-redefs"     . (:block 1))
+    ("defrecord"       . (:block 2))
+    ("deftype"         . (:block 2))
+    ("are"             . (:block 2))
+    ("as->"            . (:block 2))
+    ("catch"           . (:block 2))
+    ("condp"           . (:block 2))
+    ("bound-fn"        . (:inner 0))
+    ("def"             . (:inner 0))
+    ("defmacro"        . (:inner 0))
+    ("defmethod"       . (:inner 0))
+    ("defmulti"        . (:inner 0))
+    ("defn"            . (:inner 0))
+    ("defn-"           . (:inner 0))
+    ("defonce"         . (:inner 0))
+    ("deftest"         . (:inner 0))
+    ("fdef"            . (:inner 0))
+    ("fn"              . (:inner 0))
+    ("reify"           . (:inner 0))
+    ("use-fixtures"    . (:inner 0)))
+  "Default semantic indentation rules.
+
+The format reflects cljfmt indentation rules.  All the default rules are
+aligned with
+https://github.com/weavejester/cljfmt/blob/0.13.0/cljfmt/resources/cljfmt/indents/clojure.clj")
+
+(defun clojure-ts--match-block-0-body (bol first-child)
+  "Match if expression body is not at the same line as FIRST-CHILD.
+
+If there is no body, check that BOL is not at the same line."
+  (let* ((body-pos (if-let* ((body (treesit-node-next-sibling first-child)))
+                       (treesit-node-start body)
+                     bol)))
+    (< (line-number-at-pos (treesit-node-start first-child))
+       (line-number-at-pos body-pos))))
+
+(defun clojure-ts--node-pos-match-block (node parent bol block)
+  "Return TRUE if NODE index in the PARENT matches requested BLOCK.
+
+NODE might be nil (when we insert an empty line for example), in this
+case we look for next available child node in the PARENT after BOL
+position.
+
+The first node in the expression is usually an opening paren, the last
+node is usually a closing paren (unless some automatic parens mode is
+not enabled).  If requested BLOCK is 1, the NODE index should be at
+least 3 (first node is opening paren, second node is matched symbol,
+third node is first argument, and the rest is body which should be
+indented.)"
+  (if node
+      (> (treesit-node-index node) (1+ block))
+    (when-let* ((node-after-bol (treesit-node-first-child-for-pos parent bol)))
+      (> (treesit-node-index node-after-bol) (1+ block)))))
+
+(defun clojure-ts--match-form-body (node parent bol)
+  (and (clojure-ts--list-node-p parent)
+       (let ((first-child (clojure-ts--node-child-skip-metadata parent 0)))
+         (when-let* ((rule (alist-get (clojure-ts--named-node-text first-child)
+                                      (seq-union clojure-ts-semantic-indent-rules
+                                                 clojure-ts--semantic-indent-rules-defaults
+                                                 (lambda (e1 e2) (equal (car e1) (car e2))))
+                                      nil
+                                      nil
+                                      #'equal)))
+           (and (not (clojure-ts--match-with-metadata node))
+                (let ((rule-type (car rule))
+                      (rule-value (cadr rule)))
+                  (if (equal rule-type :block)
+                      (if (zerop rule-value)
+                          ;; Special treatment for block 0 rule.
+                          (clojure-ts--match-block-0-body bol first-child)
+                        (clojure-ts--node-pos-match-block node parent bol rule-value))
+                    ;; Return true for any inner rule.
+                    t)))))))
 
 (defun clojure-ts--match-function-call-arg (node parent _bol)
   "Match NODE if PARENT is a list expressing a function or macro call."
@@ -787,24 +897,6 @@ https://github.com/weavejester/cljfmt/blob/fb26b22f569724b05c93eb2502592dfc2de89
              (clojure-ts--keyword-node-p first-child)
              (clojure-ts--var-node-p first-child)))))
 
-(defun clojure-ts--match-expression-in-body (node parent _bol)
-  "Match NODE if it is an expression used in a body argument.
-PARENT is expected to be a list literal.
-See `treesit-simple-indent-rules'."
-  (and
-   (clojure-ts--list-node-p parent)
-   (let ((first-child (clojure-ts--node-child-skip-metadata parent 0)))
-     (and
-      (not
-       (clojure-ts--symbol-matches-p
-        ;; Symbols starting with this are false positives
-        (rx line-start (or "default" "deflate" "defer"))
-        first-child))
-      (not (clojure-ts--match-with-metadata node))
-      (clojure-ts--symbol-matches-p
-       clojure-ts--symbols-with-body-expressions-regexp
-       first-child)))))
-
 (defun clojure-ts--match-method-body (_node parent _bol)
   "Matches a `NODE' in the body of a `PARENT' method implementation.
 A method implementation referes to concrete implementations being defined in
@@ -885,7 +977,7 @@ forms like deftype, defrecord, reify, proxy, etc."
      (clojure-ts--match-docstring parent 0)
      ;; https://guide.clojure.style/#body-indentation
      (clojure-ts--match-method-body parent 2)
-     (clojure-ts--match-expression-in-body parent 2)
+     (clojure-ts--match-form-body parent 2)
      ;; https://guide.clojure.style/#threading-macros-alignment
      (clojure-ts--match-threading-macro-arg prev-sibling 0)
      ;; https://guide.clojure.style/#vertically-align-fn-args
diff --git a/test/clojure-ts-mode-indentation-test.el b/test/clojure-ts-mode-indentation-test.el
@@ -140,4 +140,103 @@ DESCRIPTION is a string with the description of the spec."
 (when-indenting-it "should support function calls via vars"
    "
 (#'foo 5
-       6)"))
+       6)")
+
+(when-indenting-it "should support block-0 expressions"
+  "
+(do (aligned)
+    (vertically))"
+
+  "
+(do
+  (indented)
+  (with-2-spaces))"
+
+  "
+(future
+  (body is indented))"
+
+  "
+(try
+  (something)
+  ;; A bit of block 2 rule
+  (catch Exception e
+    \"Third argument is indented with 2 spaces.\")
+  (catch ExceptionInfo
+         e-info
+    \"Second argument is aligned vertically with the first one.\"))")
+
+(when-indenting-it "should support block-1 expressions"
+  "
+(case x
+  2 (print 2)
+  3 (print 3)
+  (print \"Default\"))"
+
+  "
+(cond-> {}
+  :always (assoc :hello \"World\")
+  false (do nothing))"
+
+  "
+(with-precision 32
+  (/ (bigdec 20) (bigdec 30)))"
+
+  "
+(testing \"Something should work\"
+  (is (something-working?)))")
+
+(when-indenting-it "should support block-2 expressions"
+  "
+(are [x y]
+     (= x y)
+  2 3
+  4 5
+  6 6)"
+
+  "
+(as-> {} $
+  (assoc $ :hello \"World\"))"
+
+  "
+(as-> {}
+      my-map
+  (assoc my-map :hello \"World\"))"
+
+  "
+(defrecord MyThingR []
+  IProto
+  (foo [this x] x))")
+
+(when-indenting-it "should support inner-0 expressions"
+  "
+(fn named-lambda [x]
+  (+ x x))"
+
+  "
+(defmethod hello :world
+  [arg1 arg2]
+  (+ arg1 arg2))"
+
+  "
+(reify
+  AutoCloseable
+  (close
+    [this]
+    (is properly indented)))")
+
+(it "should prioritize custom semantic indentation rules"
+  (with-clojure-ts-buffer "
+(are [x y]
+     (= x y)
+  2 3
+  4 5
+  6 6)"
+    (setopt clojure-ts-semantic-indent-rules '(("are" . (:block 1))))
+    (indent-region (point-min) (point-max))
+    (expect (buffer-string) :to-equal "
+(are [x y]
+  (= x y)
+  2 3
+  4 5
+  6 6)"))))
diff --git a/test/samples/indentation.clj b/test/samples/indentation.clj
diff --git a/test/test-helper.el b/test/test-helper.el
