Improve semantic indentation rules to be more consistent with cljfmt

rrudakov · rrudakov · commit a4b20f695652 · 2025-03-25T23:00:28.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/clojure-ts-mode.el b/clojure-ts-mode.el
@@ -746,33 +746,61 @@ 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
+(defvar clojure-ts--symbols-block-0-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))))
+    (rx (and line-start
+             (or "alt!" "alt!!"
+                 "comment"
+                 "cond"
+                 "delay"
+                 "do"
+                 "finally"
+                 "future"
+                 "go"
+                 "thread"
+                 "try"
+                 "with-out-str")
+             line-end)))
   "A regex to match symbols that are functions/macros with a body argument.
-Taken from cljfmt:
+Taken from cljfmt (all symbols with [[:block 0]] rule):
+https://github.com/weavejester/cljfmt/blob/fb26b22f569724b05c93eb2502592dfc2de898c3/cljfmt/resources/cljfmt/indents/clojure.clj")
+
+(defun clojure-ts--match-block-0-body (node parent bol)
+  "Match NODE if it is an argument to a PARENT expression.
+
+Check if the first expression in the body is not at the same line as
+NODE.  If there is no body, check that BOL is not at the same line."
+  (and (clojure-ts--list-node-p parent)
+       (let* ((first-child (clojure-ts--node-child-skip-metadata parent 0))
+              (body-pos (if-let* ((body (treesit-node-next-sibling first-child)))
+                            (treesit-node-start body)
+                          bol)))
+         (and (not (clojure-ts--match-with-metadata node))
+              (clojure-ts--symbol-matches-p
+               clojure-ts--symbols-block-0-regexp
+               first-child)
+              (< (line-number-at-pos (treesit-node-start first-child))
+                 (line-number-at-pos body-pos))))))
+
+(defvar clojure-ts--symbols-block-1-regexp
+  (eval-and-compile
+    (rx (and line-start
+             (or "defprotocol"
+                 "binding"
+                 "case" "cond->" "cond->>"
+                 "doseq" "dotimes" "doto"
+                 "extend" "extend-protocol" "extend-type"
+                 "for"
+                 "go-loop"
+                 "if" "if-let" "if-not" "if-some"
+                 "let" "letfn" "locking" "loop"
+                 "match" "ns" "struct-map"
+                 "testing"
+                 "when" "when-first" "when-let" "when-not" "when-some" "while"
+                 "with-local-vars" "with-open" "with-precision" "with-redefs")
+             line-end)))
+  "A regex to match symbols that are functions/macros with a body argument.
+Taken from cljfmt (all symbols with [[:block 1]] rule):
 https://github.com/weavejester/cljfmt/blob/fb26b22f569724b05c93eb2502592dfc2de898c3/cljfmt/resources/cljfmt/indents/clojure.clj")
 
 (defun clojure-ts--match-function-call-arg (node parent _bol)
@@ -787,23 +815,93 @@ 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)
+(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-block-1-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'."
+
+The NODE has to be at least second argument of the expression.  This
+rule matches [[:block 1]] rule of cljfmt.  If NODE is nil check the next
+found node after BOL.  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)))))
+     (and (not (clojure-ts--match-with-metadata node))
+          (clojure-ts--symbol-matches-p
+           clojure-ts--symbols-block-1-regexp
+           first-child)
+          (clojure-ts--node-pos-match-block node parent bol 1)))))
+
+(defvar clojure-ts--symbols-block-2-regexp
+  (eval-and-compile
+    (rx (and line-start
+             (or "defrecord" "deftype" "are" "as->" "catch" "condp")
+             line-end)))
+  "A regex to match symbols that are functions/macros with a body argument.
+Taken from cljfmt (all symbols with [[:block 2]] rule):
+https://github.com/weavejester/cljfmt/blob/fb26b22f569724b05c93eb2502592dfc2de898c3/cljfmt/resources/cljfmt/indents/clojure.clj")
+
+(defun clojure-ts--match-block-2-body (node parent bol)
+  "Match NODE if it is an argument to a PARENT expression.
+
+The NODE has to be at least third argument of the expression.  This rule
+matches [[:block 2]] rule of cljfmt.  If NODE is nil check the next
+found node after BOL."
+  (and (clojure-ts--list-node-p parent)
+       (let ((first-child (clojure-ts--node-child-skip-metadata parent 0)))
+         (and (not (clojure-ts--match-with-metadata node))
+              (clojure-ts--symbol-matches-p
+               clojure-ts--symbols-block-2-regexp
+               first-child)
+              (clojure-ts--node-pos-match-block node parent bol 2)))))
+
+(defvar clojure-ts--symbols-inner-0-regexp
+  (eval-and-compile
+    (rx (and line-start
+             (or "bound-fn"
+                 "def"
+                 "defmacro"
+                 "defmethod"
+                 "defmulti"
+                 "defn"
+                 "defn-"
+                 "defonce"
+                 "deftest"
+                 "fdef"
+                 "fn"
+                 "reify"
+                 "use-fixtures")
+             line-end)))
+  "A regex to match symbols that match [[:inner 0]] cljfmt rule.")
+
+(defun clojure-ts--match-inner-0-body (node parent _bol)
+  "Match NODE if it is an argument to a PARENT expression.
+
+The NODE has to be a child of an epression that matches rule [[:inner
+0]] of cljfmt."
+  (and (clojure-ts--list-node-p parent)
+       (let ((first-child (clojure-ts--node-child-skip-metadata parent 0)))
+         (and (not (clojure-ts--match-with-metadata node))
+              (clojure-ts--symbol-matches-p
+               clojure-ts--symbols-inner-0-regexp
+               first-child)))))
 
 (defun clojure-ts--match-method-body (_node parent _bol)
   "Matches a `NODE' in the body of a `PARENT' method implementation.
@@ -885,7 +983,10 @@ 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-block-0-body parent 2)
+     (clojure-ts--match-block-1-body parent 2)
+     (clojure-ts--match-block-2-body parent 2)
+     (clojure-ts--match-inner-0-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,87 @@ 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)))"))
diff --git a/test/samples/indentation.clj b/test/samples/indentation.clj
@@ -79,8 +79,6 @@
   :another-keyword 2}
  "default value")
 
-
-
 (defprotocol IProto
   (foo [this x]
     "`this` is a docstring.")
@@ -121,7 +119,6 @@
           ([a b]
            b))})
 
-
 ^:foo
 (def a 1)
 
@@ -145,3 +142,71 @@
   "hello"
   [_foo]
   (+ 1 1))
+
+;;; Block 0 rule
+
+(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."))
+
+;;; Block 1 rule
+
+(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?)))
+
+;;; Block 2 rule
+
+(are [x y]
+     (= x y)
+  2 3
+  4 5
+  6 6)
+
+(as-> {} $
+  (assoc $ :hello "World"))
+
+(as-> {}
+      my-map
+  (assoc my-map :hello "World"))
+
+;;; Inner 0 rule
+
+(fn named-lambda [x]
+  (+ x x))
+
+(defmethod hello :world
+  [arg1 arg2]
+  (+ arg1 arg2))
+
+(reify
+  AutoCloseable
+  (close
+    [this]
+    (is properly indented)))
