5656; ;; Code:
5757
5858(require 'treesit )
59+ (require 'align )
5960
6061(declare-function treesit-parser-create " treesit.c"
6162(declare-function treesit-node-eq " treesit.c"
@@ -126,6 +127,70 @@ double quotes on the third column."
126127 :type 'boolean
127128 :package-version '(clojure-ts-mode . " 0.3"
128129
130+ (defcustom clojure-ts-align-reader-conditionals nil
131+ " Whether to align reader conditionals, as if they were maps."
132+ :package-version '(clojure-ts-mode . " 0.4"
133+ :safe #'booleanp
134+ :type 'boolean )
135+
136+ (defcustom clojure-ts-align-binding-forms
137+ '(" let"
138+ " when-let"
139+ " when-some"
140+ " if-let"
141+ " if-some"
142+ " binding"
143+ " loop"
144+ " doseq"
145+ " for"
146+ " with-open"
147+ " with-local-vars"
148+ " with-redefs"
149+ " clojure.core/let"
150+ " clojure.core/when-let"
151+ " clojure.core/when-some"
152+ " clojure.core/if-let"
153+ " clojure.core/if-some"
154+ " clojure.core/binding"
155+ " clojure.core/loop"
156+ " clojure.core/doseq"
157+ " clojure.core/for"
158+ " clojure.core/with-open"
159+ " clojure.core/with-local-vars"
160+ " clojure.core/with-redefs"
161+ " List of strings matching forms that have binding forms."
162+ :package-version '(clojure-ts-mode . " 0.4"
163+ :safe #'listp
164+ :type '(repeat string))
165+
166+ (defconst clojure-ts--align-separator-newline-regexp " ^ *$"
167+
168+ (defcustom clojure-ts-align-separator clojure-ts--align-separator-newline-regexp
169+ " Separator passed to `align-region' when performing vertical alignment."
170+ :package-version '(clojure-ts-mode . " 0.4"
171+ :type `(choice (const :tag " Make blank lines prevent vertical alignment from happening."
172+ , clojure-ts--align-separator-newline-regexp
173+ (other :tag " Allow blank lines to happen within a vertically-aligned expression."
174+ entire)))
175+
176+ (defcustom clojure-ts-align-cond-forms
177+ '(" condp"
178+ " cond"
179+ " cond->"
180+ " cond->>"
181+ " case"
182+ " are"
183+ " clojure.core/condp"
184+ " clojure.core/cond"
185+ " clojure.core/cond->"
186+ " clojure.core/cond->>"
187+ " clojure.core/case"
188+ " clojure.core/are"
189+ " List of strings identifying cond-like forms."
190+ :package-version '(clojure-ts-mode . " 0.4"
191+ :safe #'listp
192+ :type '(repeat string))
193+
129194(defvar clojure-ts-mode-remappings
130195 '((clojure-mode . clojure-ts-mode)
131196 (clojurescript-mode . clojure-ts-clojurescript-mode)
@@ -1025,6 +1090,18 @@ If NS is defined, then the fully qualified symbol is passed to
10251090 (seq-sort (lambda (spec1 _spec2 )
10261091 (equal (car spec1) :block )))))))))
10271092
1093+ (defun clojure-ts--find-semantic-rules-for-node (node )
1094+ " Return a list of semantic rules for NODE."
1095+ (let* ((first-child (clojure-ts--node-child-skip-metadata node 0 ))
1096+ (symbol-name (clojure-ts--named-node-text first-child))
1097+ (symbol-namespace (clojure-ts--node-namespace-text first-child)))
1098+ (or (clojure-ts--dynamic-indent-for-symbol symbol-name symbol-namespace)
1099+ (alist-get symbol-name
1100+ clojure-ts--semantic-indent-rules-cache
1101+ nil
1102+ nil
1103+ #'equal ))))
1104+
10281105(defun clojure-ts--find-semantic-rule (node parent current-depth )
10291106 " Return a suitable indentation rule for NODE, considering the CURRENT-DEPTH.
10301107
@@ -1034,16 +1111,8 @@ syntax tree and recursively attempts to find a rule, incrementally
10341111increasing the CURRENT-DEPTH. If a rule is not found upon reaching the
10351112root of the syntax tree, it returns nil. A rule is considered a match
10361113only if the CURRENT-DEPTH matches the rule's required depth."
1037- (let* ((first-child (clojure-ts--node-child-skip-metadata parent 0 ))
1038- (symbol-name (clojure-ts--named-node-text first-child))
1039- (symbol-namespace (clojure-ts--node-namespace-text first-child))
1040- (idx (- (treesit-node-index node) 2 )))
1041- (if-let* ((rule-set (or (clojure-ts--dynamic-indent-for-symbol symbol-name symbol-namespace)
1042- (alist-get symbol-name
1043- clojure-ts--semantic-indent-rules-cache
1044- nil
1045- nil
1046- #'equal ))))
1114+ (let* ((idx (- (treesit-node-index node) 2 )))
1115+ (if-let* ((rule-set (clojure-ts--find-semantic-rules-for-node parent)))
10471116 (if (zerop current-depth)
10481117 (let ((rule (car rule-set)))
10491118 (if (equal (car rule) :block )
@@ -1061,7 +1130,9 @@ only if the CURRENT-DEPTH matches the rule's required depth."
10611130 (or (null rule-idx)
10621131 (equal rule-idx idx))))))
10631132 (seq-first)))
1064- (when-let* ((new-parent (treesit-node-parent parent)))
1133+ ; ; Let's go no more than 3 levels up to avoid performance degradation.
1134+ (when-let* (((< current-depth 3 ))
1135+ (new-parent (treesit-node-parent parent)))
10651136 (clojure-ts--find-semantic-rule parent
10661137 new-parent
10671138 (1+ current-depth))))))
@@ -1188,12 +1259,6 @@ if NODE has metadata and its parent has type NODE-TYPE."
11881259 `((clojure
11891260 ((parent-is " source" 0 )
11901261 (clojure-ts--match-docstring parent 0 )
1191- ; ; https://guide.clojure.style/#body-indentation
1192- (clojure-ts--match-form-body clojure-ts--anchor-parent-skip-metadata 2 )
1193- ; ; https://guide.clojure.style/#threading-macros-alignment
1194- (clojure-ts--match-threading-macro-arg prev-sibling 0 )
1195- ; ; https://guide.clojure.style/#vertically-align-fn-args
1196- (clojure-ts--match-function-call-arg (nth-sibling 2 nil ) 0 )
11971262 ; ; Collections items with metadata.
11981263 ; ;
11991264 ; ; This should be before `clojure-ts--match-with-metadata' , otherwise they
@@ -1208,10 +1273,17 @@ if NODE has metadata and its parent has type NODE-TYPE."
12081273 ; ; All other forms with metadata.
12091274 (clojure-ts--match-with-metadata parent 0 )
12101275 ; ; Literal Sequences
1211- ((parent-is " list_lit" 1 ) ; ; https://guide.clojure.style/#one-space-indent
12121276 ((parent-is " vec_lit" 1 ) ; ; https://guide.clojure.style/#bindings-alignment
12131277 ((parent-is " map_lit" 1 ) ; ; https://guide.clojure.style/#map-keys-alignment
1214- ((parent-is " set_lit" 2 ))))
1278+ ((parent-is " set_lit" 2 )
1279+ ; ; https://guide.clojure.style/#body-indentation
1280+ (clojure-ts--match-form-body clojure-ts--anchor-parent-skip-metadata 2 )
1281+ ; ; https://guide.clojure.style/#threading-macros-alignment
1282+ (clojure-ts--match-threading-macro-arg prev-sibling 0 )
1283+ ; ; https://guide.clojure.style/#vertically-align-fn-args
1284+ (clojure-ts--match-function-call-arg (nth-sibling 2 nil ) 0 )
1285+ ; ; https://guide.clojure.style/#one-space-indent
1286+ ((parent-is " list_lit" 1 ))))
12151287
12161288(defun clojure-ts--configured-indent-rules ()
12171289 " Gets the configured choice of indent rules."
@@ -1277,9 +1349,177 @@ If JUSTIFY is non-nil, justify as well as fill the paragraph."
12771349 (markdown-inline
12781350 (sexp ,(regexp-opt clojure-ts--markdown-inline-sexp-nodes))))))
12791351
1352+ ; ;; Vertical alignment
1353+
1354+ (defun clojure-ts--beginning-of-defun-pos ()
1355+ " Return the point that represents the beginning of the current defun."
1356+ (treesit-node-start (treesit-defun-at-point)))
1357+
1358+ (defun clojure-ts--end-of-defun-pos ()
1359+ " Return the point that represends the end of the current defun."
1360+ (treesit-node-end (treesit-defun-at-point)))
1361+
1362+ (defun clojure-ts--search-whitespace-after-next-sexp (root-node bound )
1363+ " Move the point after all whitespace following the next s-expression.
1364+
1365+ Set match data group 1 to this region of whitespace and return the
1366+ point.
1367+
1368+ To move over the next s-expression, fetch the next node after the
1369+ current cursor position that is a direct child of ROOT-NODE and navigate
1370+ to its end. The most complex aspect here is handling nodes with
1371+ metadata. Some forms are represented in the syntax tree as a single
1372+ s-expression (for example, ^long my-var or ^String (str \" Hello\"
1373+ \" world\" )), while other forms are two separate s-expressions (for
1374+ example, ^long 123 or ^String \" Hello\" ). Expressions with two nodes
1375+ share some common features:
1376+
1377+ - The top-level node type is usually sym_lit
1378+
1379+ - They do not have value children, or they have an empty name.
1380+
1381+ Regular expression and syntax analysis code is borrowed from
1382+ `clojure-mode.'
1383+
1384+ BOUND bounds the whitespace search."
1385+ (unwind-protect
1386+ (when-let* ((cur-sexp (treesit-node-first-child-for-pos root-node (point ) t )))
1387+ (goto-char (treesit-node-start cur-sexp))
1388+ (if (and (string= " sym_lit"
1389+ (clojure-ts--metadata-node-p (treesit-node-child cur-sexp 0 t ))
1390+ (and (not (treesit-node-child-by-field-name cur-sexp " value"
1391+ (string-empty-p (clojure-ts--named-node-text cur-sexp))))
1392+ (treesit-end-of-thing 'sexp 2 'restricted )
1393+ (treesit-end-of-thing 'sexp 1 'restrict ))
1394+ (when (looking-at " ,"
1395+ (forward-char ))
1396+ ; ; Move past any whitespace or comment.
1397+ (search-forward-regexp " \\ ([,\s\t ]*\\ )\\ (;+.*\\ )?"
1398+ (pcase (syntax-after (point ))
1399+ ; ; End-of-line, try again on next line.
1400+ (`(12 ) (clojure-ts--search-whitespace-after-next-sexp root-node bound))
1401+ ; ; Closing paren, stop here.
1402+ (`(5 . , _nil )
1403+ ; ; Anything else is something to align.
1404+ (_ (point ))))
1405+ (when (and bound (> (point ) bound))
1406+ (goto-char bound))))
1407+
1408+ (defun clojure-ts--get-nodes-to-align (region-node beg end )
1409+ " Return a plist of nodes data for alignment.
1410+
1411+ The search is limited by BEG, END and REGION-NODE.
1412+
1413+ Possible node types are: map, bindings-vec, cond or read-cond.
1414+
1415+ The returned value is a list of property lists. Each property list
1416+ includes `:sexp-type' , `:node' , `:beg-marker' , and `:end-marker' .
1417+ Markers are necessary to fetch the same nodes after their boundaries
1418+ have changed."
1419+ (let* ((query (treesit-query-compile 'clojure
1420+ (append
1421+ `(((map_lit) @map)
1422+ ((list_lit
1423+ ((sym_lit) @sym
1424+ (:match ,(clojure-ts-symbol-regexp clojure-ts-align-binding-forms) @sym))
1425+ (vec_lit) @bindings-vec))
1426+ ((list_lit
1427+ ((sym_lit) @sym
1428+ (:match ,(clojure-ts-symbol-regexp clojure-ts-align-cond-forms) @sym)))
1429+ @cond))
1430+ (when clojure-ts-align-reader-conditionals
1431+ '(((read_cond_lit) @read-cond)))))))
1432+ (thread-last (treesit-query-capture region-node query beg end)
1433+ (seq-remove (lambda (elt ) (eq (car elt) 'sym )))
1434+ ; ; When first node is reindented, all other nodes become
1435+ ; ; outdated. Executing the entire query everytime is very
1436+ ; ; expensive, instead we use markers for every captured node to
1437+ ; ; retrieve only a single node later.
1438+ (seq-map (lambda (elt )
1439+ (let* ((sexp-type (car elt))
1440+ (node (cdr elt))
1441+ (beg-marker (copy-marker (treesit-node-start node) t ))
1442+ (end-marker (copy-marker (treesit-node-end node))))
1443+ (list :sexp-type sexp-type
1444+ :node node
1445+ :beg-marker beg-marker
1446+ :end-marker end-marker)))))))
1447+
1448+ (defun clojure-ts--point-to-align-position (sexp-type node )
1449+ " Move point to the appropriate position to align NODE.
1450+
1451+ For NODE with SEXP-TYPE map or bindings-vec, the appropriate
1452+ position is after the first opening brace.
1453+
1454+ For NODE with SEXP-TYPE cond, we need to skip the first symbol and the
1455+ subsequent special arguments based on block indentation rules."
1456+ (goto-char (treesit-node-start node))
1457+ (when-let* ((cur-sexp (treesit-node-first-child-for-pos node (point ) t )))
1458+ (goto-char (treesit-node-start cur-sexp))
1459+ ; ; For cond forms we need to skip first n + 1 nodes according to block
1460+ ; ; indentation rules. First node to skip is the symbol itself.
1461+ (when (equal sexp-type 'cond )
1462+ (if-let* ((rule-set (clojure-ts--find-semantic-rules-for-node node))
1463+ (rule (car rule-set))
1464+ ((equal (car rule) :block )))
1465+ (treesit-beginning-of-thing 'sexp (1- (- (cadr rule))) 'restrict )
1466+ (treesit-beginning-of-thing 'sexp -1 )))))
1467+
1468+ (defun clojure-ts-align (beg end )
1469+ " Vertically align the contents of the sexp around point.
1470+
1471+ If region is active, align it. Otherwise, align everything in the
1472+ current \" top-level\" sexp. When called from lisp code align everything
1473+ between BEG and END."
1474+ (interactive (if (use-region-p )
1475+ (list (region-beginning ) (region-end ))
1476+ (save-excursion
1477+ (let ((start (clojure-ts--beginning-of-defun-pos))
1478+ (end (clojure-ts--end-of-defun-pos)))
1479+ (list start end)))))
1480+ (setq end (copy-marker end))
1481+ (let* ((root-node (treesit-buffer-root-node 'clojure ))
1482+ ; ; By default `treesit-query-capture' captures all nodes that cross the
1483+ ; ; range. We need to restrict it to only nodes inside of the range.
1484+ (region-node (treesit-node-descendant-for-range root-node beg (marker-position end) t ))
1485+ (sexps-to-align (clojure-ts--get-nodes-to-align region-node beg (marker-position end))))
1486+ (save-excursion
1487+ (indent-region beg (marker-position end))
1488+ (dolist (sexp sexps-to-align)
1489+ ; ; After reindenting a node, all other nodes in the `sexps-to-align'
1490+ ; ; list become outdated, so we need to fetch updated nodes for every
1491+ ; ; iteration.
1492+ (let* ((new-root-node (treesit-buffer-root-node 'clojure ))
1493+ (new-region-node (treesit-node-descendant-for-range new-root-node
1494+ beg
1495+ (marker-position end)
1496+ t ))
1497+ (sexp-beg (marker-position (plist-get sexp :beg-marker )))
1498+ (sexp-end (marker-position (plist-get sexp :end-marker )))
1499+ (node (treesit-node-descendant-for-range new-region-node
1500+ sexp-beg
1501+ sexp-end
1502+ t ))
1503+ (sexp-type (plist-get sexp :sexp-type ))
1504+ (node-end (treesit-node-end node)))
1505+ (clojure-ts--point-to-align-position sexp-type node)
1506+ (align-region (point ) node-end nil
1507+ `((clojure-align (regexp . ,(lambda (&optional bound _noerror )
1508+ (clojure-ts--search-whitespace-after-next-sexp node bound)))
1509+ (group . 1 )
1510+ (separate . , clojure-ts-align-separator
1511+ (repeat . t )))
1512+ nil )
1513+ ; ; After every iteration we have to re-indent the s-expression,
1514+ ; ; otherwise some can be indented inconsistently.
1515+ (indent-region (marker-position (plist-get sexp :beg-marker ))
1516+ (marker-position (plist-get sexp :end-marker ))))))))
1517+
1518+
12801519(defvar clojure-ts-mode-map
12811520 (let ((map (make-sparse-keymap )))
12821521 ; ;(set-keymap-parent map clojure-mode-map)
1522+ (keymap-set map " C-c SPC" #'clojure-ts-align )
12831523 map))
12841524
12851525(defvar clojure-ts-clojurescript-mode-map
@@ -1347,6 +1587,7 @@ function can also be used to upgrade the grammars if they are outdated."
13471587(defun clojure-ts-mode-variables (&optional markdown-available )
13481588 " Initialize buffer-local variables for `clojure-ts-mode' .
13491589See `clojure-ts--font-lock-settings' for usage of MARKDOWN-AVAILABLE."
1590+ (setq-local indent-tabs-mode nil )
13501591 (setq-local comment-add 1 )
13511592 (setq-local comment-start " ;"
13521593
0 commit comments