[#16] Implement clojure-ts-align

rrudakov · rrudakov · commit b9d8ae1f92be · 2025-04-18T18:12:08.000+02:00
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -2,6 +2,8 @@
 
 ## main (unreleased)
 
+- [#16](https://github.com/clojure-emacs/clojure-ts-mode/issues/16): Introduce `clojure-ts-align`.
+
 ## 0.3.0 (2025-04-15)
 
 - [#62](https://github.com/clojure-emacs/clojure-ts-mode/issues/62): Define `list` "thing" to improve navigation in Emacs 31.
diff --git a/README.md b/README.md
@@ -239,6 +239,38 @@ should look like:
 In order to apply directory-local variables to existing buffers, they must be
 reverted.
 
+### Vertical alignment
+
+You can vertically align sexps with `C-c SPC`. For instance, typing this combo
+on the following form:
+
+```clojure
+(def my-map
+  {:a-key 1
+   :other-key 2})
+```
+
+Leads to the following:
+
+```clojure
+(def my-map
+  {:a-key     1
+   :other-key 2})
+```
+
+Forms that can be aligned vertically are configured via the following variables:
+
+- `clojure-ts-align-reader-conditionals` - align reader conditionals as if they
+  were maps.
+- `clojure-ts-align-binding-forms` - a customizable list of forms with let-like
+  bindings that can be aligned vertically.
+- `clojure-ts-align-cond-forms` - a customizable list of forms whose body
+  elements can be aligned vertically. These forms respect the block semantic
+  indentation rule (if configured) and align only the body forms, skipping N
+  special arguments.
+- `clojure-ts-align-separator` - determines whether blank lines prevent vertical
+  alignment.
+
 ### 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
@@ -56,6 +56,7 @@
 ;;; Code:
 
 (require 'treesit)
+(require 'align)
 
 (declare-function treesit-parser-create "treesit.c")
 (declare-function treesit-node-eq "treesit.c")
@@ -126,6 +127,70 @@ double quotes on the third column."
   :type 'boolean
   :package-version '(clojure-ts-mode . "0.3"))
 
+(defcustom clojure-ts-align-reader-conditionals nil
+  "Whether to align reader conditionals, as if they were maps."
+  :package-version '(clojure-ts-mode . "0.4")
+  :safe #'booleanp
+  :type 'boolean)
+
+(defcustom clojure-ts-align-binding-forms
+  '("let"
+    "when-let"
+    "when-some"
+    "if-let"
+    "if-some"
+    "binding"
+    "loop"
+    "doseq"
+    "for"
+    "with-open"
+    "with-local-vars"
+    "with-redefs"
+    "clojure.core/let"
+    "clojure.core/when-let"
+    "clojure.core/when-some"
+    "clojure.core/if-let"
+    "clojure.core/if-some"
+    "clojure.core/binding"
+    "clojure.core/loop"
+    "clojure.core/doseq"
+    "clojure.core/for"
+    "clojure.core/with-open"
+    "clojure.core/with-local-vars"
+    "clojure.core/with-redefs")
+  "List of strings matching forms that have binding forms."
+  :package-version '(clojure-ts-mode . "0.4")
+  :safe #'listp
+  :type '(repeat string))
+
+(defconst clojure-ts--align-separator-newline-regexp "^ *$")
+
+(defcustom clojure-ts-align-separator clojure-ts--align-separator-newline-regexp
+  "Separator passed to `align-region' when performing vertical alignment."
+  :package-version '(clojure-ts-mode . "0.4")
+  :type `(choice (const :tag "Make blank lines prevent vertical alignment from happening."
+                        ,clojure-ts--align-separator-newline-regexp)
+                 (other :tag "Allow blank lines to happen within a vertically-aligned expression."
+                        entire)))
+
+(defcustom clojure-ts-align-cond-forms
+  '("condp"
+    "cond"
+    "cond->"
+    "cond->>"
+    "case"
+    "are"
+    "clojure.core/condp"
+    "clojure.core/cond"
+    "clojure.core/cond->"
+    "clojure.core/cond->>"
+    "clojure.core/case"
+    "clojure.core/are")
+  "List of strings identifying cond-like forms."
+  :package-version '(clojure-ts-mode . "0.4")
+  :safe #'listp
+  :type '(repeat string))
+
 (defvar clojure-ts-mode-remappings
   '((clojure-mode . clojure-ts-mode)
     (clojurescript-mode . clojure-ts-clojurescript-mode)
@@ -1025,6 +1090,18 @@ If NS is defined, then the fully qualified symbol is passed to
                        (seq-sort (lambda (spec1 _spec2)
                                    (equal (car spec1) :block)))))))))
 
+(defun clojure-ts--find-semantic-rules-for-node (node)
+  "Return a list of semantic rules for NODE."
+  (let* ((first-child (clojure-ts--node-child-skip-metadata node 0))
+         (symbol-name (clojure-ts--named-node-text first-child))
+         (symbol-namespace (clojure-ts--node-namespace-text first-child)))
+    (or (clojure-ts--dynamic-indent-for-symbol symbol-name symbol-namespace)
+        (alist-get symbol-name
+                   clojure-ts--semantic-indent-rules-cache
+                   nil
+                   nil
+                   #'equal))))
+
 (defun clojure-ts--find-semantic-rule (node parent current-depth)
   "Return a suitable indentation rule for NODE, considering the CURRENT-DEPTH.
 
@@ -1034,16 +1111,8 @@ syntax tree and recursively attempts to find a rule, incrementally
 increasing the CURRENT-DEPTH.  If a rule is not found upon reaching the
 root of the syntax tree, it returns nil.  A rule is considered a match
 only if the CURRENT-DEPTH matches the rule's required depth."
-  (let* ((first-child (clojure-ts--node-child-skip-metadata parent 0))
-         (symbol-name (clojure-ts--named-node-text first-child))
-         (symbol-namespace (clojure-ts--node-namespace-text first-child))
-         (idx (- (treesit-node-index node) 2)))
-    (if-let* ((rule-set (or (clojure-ts--dynamic-indent-for-symbol symbol-name symbol-namespace)
-                            (alist-get symbol-name
-                                       clojure-ts--semantic-indent-rules-cache
-                                       nil
-                                       nil
-                                       #'equal))))
+  (let* ((idx (- (treesit-node-index node) 2)))
+    (if-let* ((rule-set (clojure-ts--find-semantic-rules-for-node parent)))
         (if (zerop current-depth)
             (let ((rule (car rule-set)))
               (if (equal (car rule) :block)
@@ -1277,9 +1346,147 @@ If JUSTIFY is non-nil, justify as well as fill the paragraph."
       (markdown-inline
        (sexp ,(regexp-opt clojure-ts--markdown-inline-sexp-nodes))))))
 
+;;; Vertical alignment
+
+(defun clojure-ts--beginning-of-defun-pos ()
+  "Return the point that represents the beginning of the current defun."
+  (treesit-beginning-of-defun)
+  (point))
+
+(defun clojure-ts--end-of-defun-pos ()
+  "Return the point that represends the end of the current defun."
+  (treesit-end-of-defun)
+  (point))
+
+(defun clojure-ts--search-whitespace-after-next-sexp (root-node bound)
+  "Move the point after all whitespace following the next s-expression.
+
+Set match data group 1 to this region of whitespace and return the
+point.
+
+To move over the next s-expression, fetch the next node after the
+current cursor position that is a direct child of ROOT-NODE and navigate
+to its end.  The most complex aspect here is handling nodes with
+metadata.  Some forms are represented in the syntax tree as a single
+s-expression (for example, ^long my-var or ^String (str \"Hello\"
+\"world\")), while other forms are two separate s-expressions (for
+example, ^long 123 or ^String \"Hello\").  Expressions with two nodes
+share some common features:
+
+- The top-level node type is usually sym_lit
+
+- They do not have value children, or they have an empty name.
+
+Regular expression and syntax analysis code is borrowed from
+`clojure-mode.'
+
+BOUND bounds the whitespace search."
+  (unwind-protect
+      (when-let* ((cur-sexp (treesit-node-first-child-for-pos root-node (point) t)))
+        (goto-char (treesit-node-start cur-sexp))
+        (if (and (string= "sym_lit" (treesit-node-type cur-sexp))
+                 (clojure-ts--metadata-node-p (treesit-node-child cur-sexp 0 t))
+                 (and (not (treesit-node-child-by-field-name cur-sexp "value"))
+                      (string-empty-p (clojure-ts--named-node-text cur-sexp))))
+            (treesit-end-of-thing 'sexp 2 'restricted)
+          (treesit-end-of-thing 'sexp 1 'restrict))
+        (when (looking-at ",")
+          (forward-char))
+        ;; Move past any whitespace or comment.
+        (search-forward-regexp "\\([,\s\t]*\\)\\(;+.*\\)?" bound)
+        (pcase (syntax-after (point))
+          ;; End-of-line, try again on next line.
+          (`(12) (clojure-ts--search-whitespace-after-next-sexp root-node bound))
+          ;; Closing paren, stop here.
+          (`(5 . ,_) nil)
+          ;; Anything else is something to align.
+          (_ (point))))
+    (when (and bound (> (point) bound))
+      (goto-char bound))))
+
+(defun clojure-ts--get-nodes-to-align (beg end)
+  "Return an alist of node types and nodes for alignment.
+
+The search is limited by BEG and END.
+
+Possible node types are: map, bindings-vec, cond or read-cond."
+  (let* ((query (treesit-query-compile 'clojure
+                                       (append
+                                        `(((map_lit) @map)
+                                          ((list_lit
+                                            ((sym_lit) @sym
+                                             (:match ,(clojure-ts-symbol-regexp clojure-ts-align-binding-forms) @sym))
+                                            (vec_lit) @bindings-vec))
+                                          ((list_lit
+                                            ((sym_lit) @sym
+                                             (:match ,(clojure-ts-symbol-regexp clojure-ts-align-cond-forms) @sym)))
+                                           @cond))
+                                        (when clojure-ts-align-reader-conditionals
+                                          '(((read_cond_lit) @read-cond)))))))
+    (thread-last (treesit-query-capture 'clojure query beg end)
+                 (seq-filter (lambda (elt)
+                               (member (car elt)
+                                       '(map bindings-vec cond read-cond)))))))
+
+(defun clojure-ts--point-to-align-position (sexp)
+  "Move point to the appropriate position to align SEXP.
+
+For node with sexp type map or bindings-vec, the appropriate position is
+after the first opening brace.
+
+For node with sexp type cond, we need to skip the first symbol and the
+subsequent special arguments based on block indentation rules."
+  (pcase-let ((`(,sexp-type . ,root-node) sexp))
+    (goto-char (treesit-node-start root-node))
+    (when-let* ((cur-sexp (treesit-node-first-child-for-pos root-node (point) t)))
+      (goto-char (treesit-node-start cur-sexp))
+      ;; For cond forms we need to skip first n + 1 nodes according to block
+      ;; indentation rules.  First node to skip is the symbol itself.
+      (when (equal sexp-type 'cond)
+        (if-let* ((rule-set (clojure-ts--find-semantic-rules-for-node root-node))
+                  (rule (car rule-set))
+                  ((equal (car rule) :block)))
+            (treesit-beginning-of-thing 'sexp (1- (- (cadr rule))) 'restrict)
+          (treesit-beginning-of-thing 'sexp -1))))))
+
+(defun clojure-ts-align (beg end)
+  "Vertically align the contents of the sexp around point.
+
+If region is active, align it.  Otherwise, align everything in the
+current \"top-level\" sexp.  When called from lisp code align everything
+between BEG and END."
+  (interactive (if (use-region-p)
+                   (list (region-beginning) (region-end))
+                 (save-excursion
+                   (let ((start (clojure-ts--beginning-of-defun-pos))
+                         (end (clojure-ts--end-of-defun-pos)))
+                     (list start end)))))
+  (setq end (copy-marker end))
+  (let ((sexps-to-align (clojure-ts--get-nodes-to-align beg (marker-position end))))
+    (save-excursion
+      (dotimes (idx (seq-count #'identity sexps-to-align))
+        ;; After every iteration we have to re-indent the entire defun,
+        ;; otherwise some can be indented inconsistently.
+        (indent-region beg (clojure-ts--end-of-defun-pos))
+        ;; After reindenting a node, all other nodes in the `sexps-to-align'
+        ;; list become outdated, so we need to fetch updated nodes for every
+        ;; iteration.
+        (let* ((sexp-to-align (seq-elt (clojure-ts--get-nodes-to-align beg (marker-position end)) idx))
+               (node (cdr sexp-to-align))
+               (node-end (treesit-node-end node)))
+          (clojure-ts--point-to-align-position sexp-to-align)
+          (align-region (point) node-end nil
+                        `((clojure-align (regexp . ,(lambda (&optional bound _noerror)
+                                                      (clojure-ts--search-whitespace-after-next-sexp node bound)))
+                                         (group . 1)
+                                         (separate . ,clojure-ts-align-separator)
+                                         (repeat . t)))
+                        nil))))))
+
 (defvar clojure-ts-mode-map
   (let ((map (make-sparse-keymap)))
     ;;(set-keymap-parent map clojure-mode-map)
+    (keymap-set map "C-c SPC" #'clojure-ts-align)
     map))
 
 (defvar clojure-ts-clojurescript-mode-map
@@ -1347,6 +1554,7 @@ function can also be used to upgrade the grammars if they are outdated."
 (defun clojure-ts-mode-variables (&optional markdown-available)
   "Initialize buffer-local variables for `clojure-ts-mode'.
 See `clojure-ts--font-lock-settings' for usage of MARKDOWN-AVAILABLE."
+  (setq-local indent-tabs-mode nil)
   (setq-local comment-add 1)
   (setq-local comment-start ";")
 
diff --git a/test/clojure-ts-mode-indentation-test.el b/test/clojure-ts-mode-indentation-test.el
@@ -326,3 +326,71 @@ DESCRIPTION is a string with the description of the spec."
                       (* (twice y) 3))]
   (println \"Twice 15 =\" (twice 15))
   (println \"Six times 15 =\" (six-times 15)))"))))
+
+(describe "clojure-ts-align"
+  (it "should handle improperly indented content"
+    (with-clojure-ts-buffer-point "
+(let [a-long-name 10
+b |20])"
+        (call-interactively #'clojure-ts-align)
+      (expect (buffer-string) :to-equal "
+(let [a-long-name 10
+      b           20])"))
+
+    (with-clojure-ts-buffer-point "
+(let [^long my-map {:hello \"World\" ;Hello
+ :foo
+       ^String (str \"Foo\" \"Bar\")
+ :number ^long 132
+                    :zz \"hello\"}
+      another| {:this ^{:hello \"world\"} \"is\"
+                    :a    #long \"1234\"
+ :b {:this \"is\"
+ :nested \"map\"}}])"
+        (call-interactively #'clojure-ts-align)
+      (expect (buffer-string) :to-equal "
+(let [^long my-map {:hello  \"World\" ;Hello
+                    :foo
+                    ^String (str \"Foo\" \"Bar\")
+                    :number ^long 132
+                    :zz     \"hello\"}
+      another      {:this ^{:hello \"world\"} \"is\"
+                    :a    #long \"1234\"
+                    :b    {:this   \"is\"
+                           :nested \"map\"}}])"))
+
+    (with-clojure-ts-buffer-point "
+(condp = 2
+|123 \"Hello\"
+99999 \"World\"
+234 nil)"
+        (call-interactively #'clojure-ts-align)
+      (expect (buffer-string) :to-equal "
+(condp = 2
+  123   \"Hello\"
+  99999 \"World\"
+  234   nil)")))
+
+  (it "should not align reader conditionals by defaul"
+    (with-clojure-ts-buffer-point "
+#?(:clj 2
+   |:cljs 2)"
+        (call-interactively #'clojure-ts-align)
+      (expect (buffer-string) :to-equal "
+#?(:clj 2
+   :cljs 2)")))
+
+  (it "should align reader conditionals when clojure-ts-align-reader-conditionals is true"
+    (with-clojure-ts-buffer-point "
+#?(:clj 2
+   |:cljs 2)"
+        (setq-local clojure-ts-align-reader-conditionals t)
+      (call-interactively #'clojure-ts-align)
+      (expect (buffer-string) :to-equal "
+#?(:clj  2
+   :cljs 2)")))
+
+  (it "should remove extra commas"
+    (with-clojure-ts-buffer-point "{|:a 2, ,:c 4}"
+        (call-interactively #'clojure-ts-align)
+      (expect (buffer-string) :to-equal "{:a 2, :c 4}"))))
diff --git a/test/samples/align.clj b/test/samples/align.clj
