Add refactoring command for converting #() shorthand to (fn ...) (#601)

CHANGELOG.md

@@ -6,6 +6,7 @@
 
 * Allow additional directories, beyond the default `clj[sc]`, to be correctly formulated by `clojure-expected-ns` via new `defcustom` entitled `clojure-directory-prefixes`
 * Recognize babashka projects (identified by the presence of `bb.edn`).
+* [#601](https://github.com/clojure-emacs/clojure-mode/pull/601): Add new command `clojure-promote-fn-literal` for converting #() function literals to `fn` form 
 
 ### Changes
 

clojure-mode.el

@@ -263,6 +263,8 @@ The prefixes are used to generate the correct namespace."
     (define-key map (kbd "C--") #'clojure-toggle-ignore)
     (define-key map (kbd "_") #'clojure-toggle-ignore-surrounding-form)
     (define-key map (kbd "C-_") #'clojure-toggle-ignore-surrounding-form)
+    (define-key map (kbd "P") #'clojure-promote-fn-literal)
+    (define-key map (kbd "C-P") #'clojure-promote-fn-literal)
     map)
   "Keymap for Clojure refactoring commands.")
 (fset 'clojure-refactor-map clojure-refactor-map)
@@ -284,6 +286,7 @@ The prefixes are used to generate the correct namespace."
         ["Toggle #_ ignore form" clojure-toggle-ignore]
         ["Toggle #_ ignore of surrounding form" clojure-toggle-ignore-surrounding-form]
         ["Add function arity" clojure-add-arity]
+        ["Promote #() fn literal" clojure-promote-fn-literal]
         ("ns forms"
          ["Insert ns form at the top" clojure-insert-ns-form]
          ["Insert ns form here" clojure-insert-ns-form-at-point]
@@ -2769,6 +2772,67 @@ With a numeric prefix argument the let is introduced N lists up."
   (interactive)
   (clojure--move-to-let-internal (read-from-minibuffer "Name of bound symbol: ")))
 
+;;; Promoting #() function literals
+(defun clojure--gather-fn-literal-args ()
+  "Return a cons cell (ARITY . VARARG)
+ARITY is number of arguments in the function,
+VARARG is a boolean of whether it takes a variable argument %&."
+  (save-excursion
+    (let ((end (save-excursion (clojure-forward-logical-sexp) (point)))
+          (rgx (rx symbol-start "%" (group (?  (or "&" (+ (in "0-9"))))) symbol-end))
+          (arity 0)
+          (vararg nil))
+      (while (re-search-forward rgx end 'noerror)
+        (when (not (or (clojure--in-comment-p) (clojure--in-string-p)))
+          (let ((s (match-string 1)))
+            (if (string= s "&")
+                (setq vararg t)
+              (setq arity
+                    (max arity
+                         (if (string= s "") 1
+                           (string-to-number s))))))))
+      (cons arity vararg))))
+
+(defun clojure--substitute-fn-literal-arg (arg sub end)
+  "ARG is either a number or the symbol '&.
+SUB is a string to substitute with, and
+END marks the end of the fn expression"
+  (save-excursion
+    (let ((rgx (format "\\_<%%%s\\_>" (if (eq arg 1) "1?" arg))))
+      (while (re-search-forward rgx end 'noerror)
+        (when (and (not (clojure--in-comment-p))
+                   (not (clojure--in-string-p)))
+          (replace-match sub))))))
+
+(defun clojure-promote-fn-literal ()
+  "Convert a #(...) function into (fn [...] ...), prompting for the argument names."
+  (interactive)
+  (when-let (beg (clojure-string-start))
+    (goto-char beg))
+  (if (or (looking-at-p "#(")
+          (ignore-errors (forward-char 1))
+          (re-search-backward "#(" (save-excursion (beginning-of-defun) (point)) 'noerror))
+      (let* ((end (save-excursion (clojure-forward-logical-sexp) (point-marker)))
+             (argspec (clojure--gather-fn-literal-args))
+             (arity (car argspec))
+             (vararg (cdr argspec)))
+        (delete-char 1)
+        (save-excursion (forward-sexp 1) (insert ")"))
+        (save-excursion
+          (insert "(fn [] ")
+          (backward-char 2)
+          (mapc (lambda (n)
+                  (let ((name (read-string (format "Name of argument %d: " n))))
+                    (when (/= n 1) (insert " "))
+                    (insert name)
+                    (clojure--substitute-fn-literal-arg n name end)))
+                (number-sequence 1 arity))
+          (when vararg
+            (insert " & ")
+            (let ((name (read-string "Name of variadic argument: ")))
+              (insert name)
+              (clojure--substitute-fn-literal-arg '& name end)))))
+    (user-error "No #() literal at point!")))
 
 ;;; Renaming ns aliases
 

test/clojure-mode-promote-fn-literal-test.el

@@ -0,0 +1,72 @@
+;;; clojure-mode-promote-fn-literal-test.el --- Clojure Mode: convert fn syntax -*- lexical-binding: t; -*-
+
+;; This file is not part of GNU Emacs.
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for clojure-promote-fn-literal
+
+;;; Code:
+
+(require 'clojure-mode)
+(require 'buttercup)
+
+(describe "clojure-promote-fn-literal"
+  :var (names)
+
+  (before-each
+    (spy-on 'read-string
+            :and-call-fake (lambda (_) (or (pop names) (error "")))))
+
+  (when-refactoring-it "should convert 0-arg fns"
+    "#(rand)"
+    "(fn [] (rand))"
+    (clojure-promote-fn-literal))
+
+  (when-refactoring-it "should convert 1-arg fns"
+    "#(= % 1)"
+    "(fn [x] (= x 1))"
+    (setq names '("x"))
+    (clojure-promote-fn-literal))
+
+  (when-refactoring-it "should convert 2-arg fns"
+    "#(conj (pop %) (assoc (peek %1) %2 (* %2 %2)))"
+    "(fn [acc x] (conj (pop acc) (assoc (peek acc) x (* x x))))"
+    (setq names '("acc" "x"))
+    (clojure-promote-fn-literal))
+
+  (when-refactoring-it "should convert variadic fns"
+    ;; from https://hypirion.com/musings/swearjure
+    "#(* (`[~@%&] (+))
+   ((% (+)) % (- (`[~@%&] (+)) (*))))"
+    "(fn [v & vs] (* (`[~@vs] (+))
+   ((v (+)) v (- (`[~@vs] (+)) (*)))))"
+    (setq names '("v" "vs"))
+    (clojure-promote-fn-literal))
+
+  (when-refactoring-it "should ignore strings and comments"
+    "#(format \"%2\" ;; FIXME: %2 is an illegal specifier
+   %7) "
+    "(fn [_ _ _ _ _ _ id] (format \"%2\" ;; FIXME: %2 is an illegal specifier
+   id)) "
+    (setq names '("_" "_" "_" "_" "_" "_" "id"))
+    (clojure-promote-fn-literal)))
+
+
+(provide 'clojure-mode-convert-fn-test)
+
+
+;;; clojure-mode-promote-fn-literal-test.el ends here