diff --git a/CHANGELOG.md b/CHANGELOG.md index d40be97..7dd9d56 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ - Syntax highlighting of built-in keywords. - Consistent indentation with regular forms. - Support for automatic aligning forms. +- [#88](https://github.com/clojure-emacs/clojure-ts-mode/pull/88): Introduce `clojure-ts-unwind` and `clojure-ts-unwind-all`. ## 0.3.0 (2025-04-15) diff --git a/README.md b/README.md index cf83375..f2d656c 100644 --- a/README.md +++ b/README.md @@ -372,6 +372,28 @@ following customization: (setopt clojure-ts-outline-variant 'imenu) ``` +## Refactoring support + +### Threading macros related features + +`clojure-unwind`: Unwind a threaded expression. Supports both `->>`/`some->>` +and `->`/`some->`. + +`clojure-unwind-all`: Fully unwind a threaded expression removing the threading +macro. + +### Default keybindings + +| Keybinding | Command | +|:------------|:--------------------| +| `C-c SPC` | `clojure-ts-align` | +| `C-c C-r u` | `clojure-ts-unwind` | + +### Customize refactoring commands prefix + +By default prefix for all refactoring commands is `C-c C-r`. It can be changed +by customizing `clojure-ts-refactor-map-prefix` variable. + ## Migrating to clojure-ts-mode If you are migrating to `clojure-ts-mode` note that `clojure-mode` is still diff --git a/clojure-ts-mode.el b/clojure-ts-mode.el index e4ac5e1..4559e60 100644 --- a/clojure-ts-mode.el +++ b/clojure-ts-mode.el @@ -57,6 +57,7 @@ (require 'treesit) (require 'align) +(require 'subr-x) (declare-function treesit-parser-create "treesit.c") (declare-function treesit-node-eq "treesit.c") @@ -144,6 +145,11 @@ three or more semicolons will be treated as outline headings. If set to (const :tag "Use imenu" imenu)) :package-version '(clojure-ts-mode . "0.4")) +(defcustom clojure-ts-refactor-map-prefix "C-c C-r" + "Clojure refactor keymap prefix." + :type 'string + :package-version '(clojure-ts-mode . "0.4")) + (defcustom clojure-ts-align-reader-conditionals nil "Whether to align reader conditionals, as if they were maps." :package-version '(clojure-ts-mode . "0.4") @@ -1691,11 +1697,199 @@ Forms between BEG and END are aligned according to (when clojure-ts-align-forms-automatically (clojure-ts-align beg end)))) +;;; Refactoring + +(defun clojure-ts--threading-sexp-node () + "Return list node at point which is a threading expression." + (when-let* ((node-at-point (treesit-node-at (point) 'clojure t))) + ;; We don't want to match `cond->' and `cond->>', so we should define a very + ;; specific regexp. + (let ((sym-regex (rx bol (* "some") "->" (* ">") eol))) + (treesit-parent-until node-at-point + (lambda (node) + (and (or (clojure-ts--list-node-p node) + (clojure-ts--anon-fn-node-p node)) + (let ((first-child (treesit-node-child node 0 t))) + (clojure-ts--symbol-matches-p sym-regex first-child)))) + t)))) + +(defun clojure-ts--delete-and-extract-sexp () + "Delete the surrounding sexp and return it." + (let* ((sexp-node (treesit-thing-at-point 'sexp 'nested)) + (result (treesit-node-text sexp-node))) + (delete-region (treesit-node-start sexp-node) + (treesit-node-end sexp-node)) + result)) + +(defun clojure-ts--ensure-parens-around-function-name () + "Insert parens around function name if necessary." + (unless (string= (treesit-node-text (treesit-node-at (point))) "(") + (insert-parentheses 1) + (backward-up-list))) + +(defun clojure-ts--multiline-sexp-p () + "Return TRUE if s-expression at point is multiline." + (let ((sexp (treesit-thing-at-point 'sexp 'nested))) + (not (= (line-number-at-pos (treesit-node-start sexp)) + (line-number-at-pos (treesit-node-end sexp)))))) + +(defun clojure-ts--unwind-thread-first () + "Unwind a thread first macro once." + (let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (first-child-start (thread-first threading-sexp + (treesit-node-child 0 t) + (treesit-node-start) + (copy-marker)))) + (save-excursion + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((contents (clojure-ts--delete-and-extract-sexp))) + (when (looking-at " *\n") + (join-line 'following)) + (just-one-space) + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((multiline-p (clojure-ts--multiline-sexp-p))) + (clojure-ts--ensure-parens-around-function-name) + (down-list) + (forward-sexp) + (insert " " contents) + (when multiline-p + (insert "\n"))))))) + +(defun clojure-ts--unwind-thread-last () + "Unwind a thread last macro once." + (let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (first-child-start (thread-first threading-sexp + (treesit-node-child 0 t) + (treesit-node-start) + (copy-marker)))) + (save-excursion + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((contents (clojure-ts--delete-and-extract-sexp))) + (when (looking-at " *\n") + (join-line 'following)) + (just-one-space) + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((multiline-p (clojure-ts--multiline-sexp-p))) + (clojure-ts--ensure-parens-around-function-name) + (forward-list) + (down-list -1) + (when multiline-p + (insert "\n")) + (insert " " contents)))))) + +(defun clojure-ts--node-threading-p (node) + "Return non-nil if NODE is a threading macro s-expression." + (and (or (clojure-ts--list-node-p node) + (clojure-ts--anon-fn-node-p node)) + (let ((first-child (treesit-node-child node 0 t))) + (clojure-ts--symbol-matches-p clojure-ts--threading-macro first-child)))) + +(defun clojure-ts--skip-first-child (parent) + "Move point to the beginning of the first child of the PARENT node." + (thread-first parent + (treesit-node-child 1 t) + (treesit-node-start) + (goto-char))) + +(defun clojure-ts--nothing-more-to-unwind () + "Return TRUE if threading expression at point has only one argument." + (let ((threading-sexp (clojure-ts--threading-sexp-node))) + (save-excursion + (clojure-ts--skip-first-child threading-sexp) + (not (treesit-end-of-thing 'sexp 2 'restricted))))) + +(defun clojure-ts--pop-out-of-threading () + "Raise a sexp up a level to unwind a threading form." + (let ((threading-sexp (clojure-ts--threading-sexp-node))) + (save-excursion + (clojure-ts--skip-first-child threading-sexp) + (raise-sexp)))) + +(defun clojure-ts--fix-sexp-whitespace () + "Fix whitespace after unwinding a threading form." + (save-excursion + (let ((beg (point))) + (treesit-end-of-thing 'sexp) + (indent-region beg (point)) + (delete-trailing-whitespace beg (point))))) + +(defun clojure-ts--unwind-sexps-counter () + "Return total number of s-expressions of a threading form at point." + (if-let* ((threading-sexp (clojure-ts--threading-sexp-node))) + (save-excursion + (clojure-ts--skip-first-child threading-sexp) + (let ((n 0)) + (while (treesit-end-of-thing 'sexp 1 'restricted) + (setq n (1+ n))) + n)) + (user-error "No threading form to unwind at point"))) + +(defun clojure-ts-unwind (&optional n) + "Unwind thread at point or above point by N levels. + +With universal argument \\[universal-argument], fully unwinds thread." + (interactive "P") + (setq n (cond + ((equal n '(4)) (clojure-ts--unwind-sexps-counter)) + (n) + (1))) + (if-let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (sym (thread-first threading-sexp + (treesit-node-child 0 t) + (clojure-ts--named-node-text)))) + (save-excursion + (let ((beg (thread-first threading-sexp + (treesit-node-start) + (copy-marker))) + (end (thread-first threading-sexp + (treesit-node-end) + (copy-marker)))) + (while (> n 0) + (cond + ((string-match-p (rx bol (* "some") "->" eol) sym) + (clojure-ts--unwind-thread-first)) + ((string-match-p (rx bol (* "some") "->>" eol) sym) + (clojure-ts--unwind-thread-last))) + (setq n (1- n)) + ;; After unwinding we check if it is the last expression and maybe + ;; splice it. + (when (clojure-ts--nothing-more-to-unwind) + (clojure-ts--pop-out-of-threading) + (clojure-ts--fix-sexp-whitespace) + (setq n 0))) + (indent-region beg end) + (delete-trailing-whitespace beg end))) + (user-error "No threading form to unwind at point"))) + +(defun clojure-ts-unwind-all () + "Fully unwind thread at point or above point." + (interactive) + (clojure-ts-unwind '(4))) + +(defvar clojure-ts-refactor-map + (let ((map (make-sparse-keymap))) + (keymap-set map "C-u" #'clojure-ts-unwind) + (keymap-set map "u" #'clojure-ts-unwind) + map) + "Keymap for `clojure-ts-mode' refactoring commands.") + (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)) + (keymap-set map clojure-ts-refactor-map-prefix clojure-ts-refactor-map) + (easy-menu-define clojure-ts-mode-menu map "Clojure[TS] Mode Menu" + '("Clojure" + ["Align expression" clojure-ts-align] + ("Refactor -> and ->>" + ["Unwind once" clojure-ts-unwind] + ["Fully unwind a threading macro" clojure-ts-unwind-all]))) + map) + "Keymap for `clojure-ts-mode'.") (defvar clojure-ts-clojurescript-mode-map (let ((map (make-sparse-keymap))) diff --git a/test/clojure-ts-mode-font-lock-test.el b/test/clojure-ts-mode-font-lock-test.el index 05eba9e..8611211 100644 --- a/test/clojure-ts-mode-font-lock-test.el +++ b/test/clojure-ts-mode-font-lock-test.el @@ -34,9 +34,9 @@ (declare (debug t) (indent 1)) `(with-clojure-ts-buffer ,content - (font-lock-ensure) - (goto-char (point-min)) - ,@body)) + (font-lock-ensure) + (goto-char (point-min)) + ,@body)) (defun clojure-ts-get-face-at (start end content) "Get the face between START and END in CONTENT." diff --git a/test/clojure-ts-mode-refactor-threading-test.el b/test/clojure-ts-mode-refactor-threading-test.el new file mode 100644 index 0000000..45aaa17 --- /dev/null +++ b/test/clojure-ts-mode-refactor-threading-test.el @@ -0,0 +1,166 @@ +;;; clojure-ts-mode-refactor-threading-test.el --- clojure-ts-mode: refactor threading tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; Author: Roman Rudakov +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The threading refactoring code is adapted from clojure-mode.el. + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'test-helper "test/test-helper") + +(describe "clojure-unwind" + + (when-refactoring-it "should unwind -> one step" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind -> completely" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind ->> one step" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind ->> completely" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(map square (filter even? [1 2 3 4 5]))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind N steps with numeric prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(->> (map square (filter even? [1 2 3 4 5])) + sum)" + + (clojure-ts-unwind 2)) + + (when-refactoring-it "should unwind completely with universal prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(sum (map square (filter even? [1 2 3 4 5])))" + + (clojure-ts-unwind '(4))) + + (when-refactoring-it "should unwind correctly when multiple ->> are present on same line" + "(->> 1 inc) (->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> 1 inc) (map square (filter even? [1 2 3 4 5]))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind with function name" + "(->> [1 2 3 4 5] + sum + square)" + + "(->> (sum [1 2 3 4 5]) + square)" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind with function name twice" + "(-> [1 2 3 4 5] + sum + square)" + + "(square (sum [1 2 3 4 5]))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should thread-issue-6-1" + "(defn plus [a b] + (-> a (+ b)))" + + "(defn plus [a b] + (+ a b))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should thread-issue-6-2" + "(defn plus [a b] + (->> a (+ b)))" + + "(defn plus [a b] + (+ b a))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind some->" + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + "(some-> (val (find {:a 1} :b)) + (+ 5))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind some->>" + "(some->> :b + (find {:a 1}) val + (+ 5))" + + "(some->> (val (find {:a 1} :b)) + (+ 5))" + + (clojure-ts-unwind) + (clojure-ts-unwind))) + +(provide 'clojure-ts-mode-refactor-threading-test) +;;; clojure-ts-mode-refactor-threading-test.el ends here diff --git a/test/clojure-ts-mode-util-test.el b/test/clojure-ts-mode-util-test.el index 8156c1a..05b0fcc 100644 --- a/test/clojure-ts-mode-util-test.el +++ b/test/clojure-ts-mode-util-test.el @@ -31,101 +31,101 @@ (describe "clojure-ts-find-ns" (it "should find common namespace declarations" (with-clojure-ts-buffer "(ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns foo.baz)" - (expect (clojure-ts-find-ns) :to-equal "foo.baz")) + (expect (clojure-ts-find-ns) :to-equal "foo.baz")) (with-clojure-ts-buffer "(ns ^:bar foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns ^:bar ^:baz foo)" - (expect (clojure-ts-find-ns) :to-equal "foo"))) + (expect (clojure-ts-find-ns) :to-equal "foo"))) (it "should find namespaces with spaces before ns form" (with-clojure-ts-buffer " (ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo"))) + (expect (clojure-ts-find-ns) :to-equal "foo"))) (it "should skip namespaces within any comment forms" (with-clojure-ts-buffer "(comment (ns foo))" - (expect (clojure-ts-find-ns) :to-equal nil)) + (expect (clojure-ts-find-ns) :to-equal nil)) (with-clojure-ts-buffer " (ns foo) (comment (ns bar))" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer " (comment (ns foo)) (ns bar) (comment (ns baz))" - (expect (clojure-ts-find-ns) :to-equal "bar"))) + (expect (clojure-ts-find-ns) :to-equal "bar"))) (it "should find namespace declarations with nested metadata and docstrings" (with-clojure-ts-buffer "(ns ^{:bar true} foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns #^{:bar true} foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns #^{:fail {}} foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns ^{:fail2 {}} foo.baz)" - (expect (clojure-ts-find-ns) :to-equal "foo.baz")) + (expect (clojure-ts-find-ns) :to-equal "foo.baz")) (with-clojure-ts-buffer "(ns ^{} foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns ^{:skip-wiki true} aleph.netty)" - (expect (clojure-ts-find-ns) :to-equal "aleph.netty")) + (expect (clojure-ts-find-ns) :to-equal "aleph.netty")) (with-clojure-ts-buffer "(ns ^{:foo {:bar :baz} :fake (ns in.meta)} foo \"docstring (ns misleading)\")" - (expect (clojure-ts-find-ns) :to-equal "foo"))) + (expect (clojure-ts-find-ns) :to-equal "foo"))) (it "should support non-alphanumeric characters" (with-clojure-ts-buffer "(ns foo+)" - (expect (clojure-ts-find-ns) :to-equal "foo+")) + (expect (clojure-ts-find-ns) :to-equal "foo+")) (with-clojure-ts-buffer "(ns bar**baz$-_quux)" - (expect (clojure-ts-find-ns) :to-equal "bar**baz$-_quux")) + (expect (clojure-ts-find-ns) :to-equal "bar**baz$-_quux")) (with-clojure-ts-buffer "(ns aoc-2019.puzzles.day14)" - (expect (clojure-ts-find-ns) :to-equal "aoc-2019.puzzles.day14"))) + (expect (clojure-ts-find-ns) :to-equal "aoc-2019.puzzles.day14"))) (it "should support in-ns forms" (with-clojure-ts-buffer "(in-ns 'bar.baz)" - (expect (clojure-ts-find-ns) :to-equal "bar.baz"))) + (expect (clojure-ts-find-ns) :to-equal "bar.baz"))) (it "should take the first ns instead of closest unlike clojure-mode" (with-clojure-ts-buffer " (ns foo1) (ns foo2)" - (expect (clojure-ts-find-ns) :to-equal "foo1")) + (expect (clojure-ts-find-ns) :to-equal "foo1")) (with-clojure-ts-buffer-point " (in-ns foo1) (ns 'foo2) (in-ns 'foo3) | (ns foo4)" - (expect (clojure-ts-find-ns) :to-equal "foo3")) + (expect (clojure-ts-find-ns) :to-equal "foo3")) (with-clojure-ts-buffer "(ns foo) (ns-unmap *ns* 'map) (ns.misleading 1 2 3)" - (expect (clojure-ts-find-ns) :to-equal "foo"))) + (expect (clojure-ts-find-ns) :to-equal "foo"))) (it "should skip leading garbage" (with-clojure-ts-buffer " (ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "1(ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "1 (ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "1 (ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "[1] (ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "[1] (ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "[1](ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns)(ns foo)" - (expect (clojure-ts-find-ns) :to-equal "foo")) + (expect (clojure-ts-find-ns) :to-equal "foo")) (with-clojure-ts-buffer "(ns 'foo)(ns bar)" - (expect (clojure-ts-find-ns) :to-equal "bar")))) + (expect (clojure-ts-find-ns) :to-equal "bar")))) diff --git a/test/samples/refactoring.clj b/test/samples/refactoring.clj new file mode 100644 index 0000000..7c3487f --- /dev/null +++ b/test/samples/refactoring.clj @@ -0,0 +1,37 @@ +(ns refactoring) + +;;; Threading + +(-> ;; This is comment + (foo) + ;; Another comment + (bar true + ;; Hello + false) + (baz)) + + +(let [some (->> yeah + (world foo + false) + hello)]) + +(->> coll + (filter identity) + (map :id) + (map :name)) + +(some->> coll + (filter identity) + (map :id) + (map :name)) + +(defn plus [a b] + (-> a (+ b))) + +(some->> :b + (find {:a 1}) val + (+ 5)) + +(some->> (val (find {:a 1} :b)) + (+ 5)) diff --git a/test/test-helper.el b/test/test-helper.el index f363644..a99ceec 100644 --- a/test/test-helper.el +++ b/test/test-helper.el @@ -42,10 +42,10 @@ and point left there." (declare (indent 2)) `(progn (with-clojure-ts-buffer ,text - (goto-char (point-min)) - (re-search-forward "|") - (delete-char -1) - ,@body))) + (goto-char (point-min)) + (re-search-forward "|") + (delete-char -1) + ,@body))) (defun clojure-ts--s-index-of (needle s &optional ignore-case) "Returns first index of NEEDLE in S, or nil. @@ -108,4 +108,5 @@ Removes the temp directory at the end of evaluation." ,@body) (delete-directory ,temp-dir t)))) +(provide 'test-helper) ;;; test-helper.el ends here