Skip to content

Commit 7d3c0c1

Browse files
authored
Add refactoring command for converting #() shorthand to (fn ...) (#601)
1 parent 08986ac commit 7d3c0c1

File tree

3 files changed

+137
-0
lines changed

3 files changed

+137
-0
lines changed

CHANGELOG.md

+1
Original file line numberDiff line numberDiff line change
@@ -6,6 +6,7 @@
66

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

1011
### Changes
1112

clojure-mode.el

+64
Original file line numberDiff line numberDiff line change
@@ -263,6 +263,8 @@ The prefixes are used to generate the correct namespace."
263263
(define-key map (kbd "C--") #'clojure-toggle-ignore)
264264
(define-key map (kbd "_") #'clojure-toggle-ignore-surrounding-form)
265265
(define-key map (kbd "C-_") #'clojure-toggle-ignore-surrounding-form)
266+
(define-key map (kbd "P") #'clojure-promote-fn-literal)
267+
(define-key map (kbd "C-P") #'clojure-promote-fn-literal)
266268
map)
267269
"Keymap for Clojure refactoring commands.")
268270
(fset 'clojure-refactor-map clojure-refactor-map)
@@ -284,6 +286,7 @@ The prefixes are used to generate the correct namespace."
284286
["Toggle #_ ignore form" clojure-toggle-ignore]
285287
["Toggle #_ ignore of surrounding form" clojure-toggle-ignore-surrounding-form]
286288
["Add function arity" clojure-add-arity]
289+
["Promote #() fn literal" clojure-promote-fn-literal]
287290
("ns forms"
288291
["Insert ns form at the top" clojure-insert-ns-form]
289292
["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."
27692772
(interactive)
27702773
(clojure--move-to-let-internal (read-from-minibuffer "Name of bound symbol: ")))
27712774

2775+
;;; Promoting #() function literals
2776+
(defun clojure--gather-fn-literal-args ()
2777+
"Return a cons cell (ARITY . VARARG)
2778+
ARITY is number of arguments in the function,
2779+
VARARG is a boolean of whether it takes a variable argument %&."
2780+
(save-excursion
2781+
(let ((end (save-excursion (clojure-forward-logical-sexp) (point)))
2782+
(rgx (rx symbol-start "%" (group (? (or "&" (+ (in "0-9"))))) symbol-end))
2783+
(arity 0)
2784+
(vararg nil))
2785+
(while (re-search-forward rgx end 'noerror)
2786+
(when (not (or (clojure--in-comment-p) (clojure--in-string-p)))
2787+
(let ((s (match-string 1)))
2788+
(if (string= s "&")
2789+
(setq vararg t)
2790+
(setq arity
2791+
(max arity
2792+
(if (string= s "") 1
2793+
(string-to-number s))))))))
2794+
(cons arity vararg))))
2795+
2796+
(defun clojure--substitute-fn-literal-arg (arg sub end)
2797+
"ARG is either a number or the symbol '&.
2798+
SUB is a string to substitute with, and
2799+
END marks the end of the fn expression"
2800+
(save-excursion
2801+
(let ((rgx (format "\\_<%%%s\\_>" (if (eq arg 1) "1?" arg))))
2802+
(while (re-search-forward rgx end 'noerror)
2803+
(when (and (not (clojure--in-comment-p))
2804+
(not (clojure--in-string-p)))
2805+
(replace-match sub))))))
2806+
2807+
(defun clojure-promote-fn-literal ()
2808+
"Convert a #(...) function into (fn [...] ...), prompting for the argument names."
2809+
(interactive)
2810+
(when-let (beg (clojure-string-start))
2811+
(goto-char beg))
2812+
(if (or (looking-at-p "#(")
2813+
(ignore-errors (forward-char 1))
2814+
(re-search-backward "#(" (save-excursion (beginning-of-defun) (point)) 'noerror))
2815+
(let* ((end (save-excursion (clojure-forward-logical-sexp) (point-marker)))
2816+
(argspec (clojure--gather-fn-literal-args))
2817+
(arity (car argspec))
2818+
(vararg (cdr argspec)))
2819+
(delete-char 1)
2820+
(save-excursion (forward-sexp 1) (insert ")"))
2821+
(save-excursion
2822+
(insert "(fn [] ")
2823+
(backward-char 2)
2824+
(mapc (lambda (n)
2825+
(let ((name (read-string (format "Name of argument %d: " n))))
2826+
(when (/= n 1) (insert " "))
2827+
(insert name)
2828+
(clojure--substitute-fn-literal-arg n name end)))
2829+
(number-sequence 1 arity))
2830+
(when vararg
2831+
(insert " & ")
2832+
(let ((name (read-string "Name of variadic argument: ")))
2833+
(insert name)
2834+
(clojure--substitute-fn-literal-arg '& name end)))))
2835+
(user-error "No #() literal at point!")))
27722836

27732837
;;; Renaming ns aliases
27742838

Original file line numberDiff line numberDiff line change
@@ -0,0 +1,72 @@
1+
;;; clojure-mode-promote-fn-literal-test.el --- Clojure Mode: convert fn syntax -*- lexical-binding: t; -*-
2+
3+
;; This file is not part of GNU Emacs.
4+
5+
;; This program is free software; you can redistribute it and/or modify
6+
;; it under the terms of the GNU General Public License as published by
7+
;; the Free Software Foundation, either version 3 of the License, or
8+
;; (at your option) any later version.
9+
10+
;; This program is distributed in the hope that it will be useful,
11+
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12+
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+
;; GNU General Public License for more details.
14+
15+
;; You should have received a copy of the GNU General Public License
16+
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
17+
18+
;;; Commentary:
19+
20+
;; Tests for clojure-promote-fn-literal
21+
22+
;;; Code:
23+
24+
(require 'clojure-mode)
25+
(require 'buttercup)
26+
27+
(describe "clojure-promote-fn-literal"
28+
:var (names)
29+
30+
(before-each
31+
(spy-on 'read-string
32+
:and-call-fake (lambda (_) (or (pop names) (error "")))))
33+
34+
(when-refactoring-it "should convert 0-arg fns"
35+
"#(rand)"
36+
"(fn [] (rand))"
37+
(clojure-promote-fn-literal))
38+
39+
(when-refactoring-it "should convert 1-arg fns"
40+
"#(= % 1)"
41+
"(fn [x] (= x 1))"
42+
(setq names '("x"))
43+
(clojure-promote-fn-literal))
44+
45+
(when-refactoring-it "should convert 2-arg fns"
46+
"#(conj (pop %) (assoc (peek %1) %2 (* %2 %2)))"
47+
"(fn [acc x] (conj (pop acc) (assoc (peek acc) x (* x x))))"
48+
(setq names '("acc" "x"))
49+
(clojure-promote-fn-literal))
50+
51+
(when-refactoring-it "should convert variadic fns"
52+
;; from https://hypirion.com/musings/swearjure
53+
"#(* (`[~@%&] (+))
54+
((% (+)) % (- (`[~@%&] (+)) (*))))"
55+
"(fn [v & vs] (* (`[~@vs] (+))
56+
((v (+)) v (- (`[~@vs] (+)) (*)))))"
57+
(setq names '("v" "vs"))
58+
(clojure-promote-fn-literal))
59+
60+
(when-refactoring-it "should ignore strings and comments"
61+
"#(format \"%2\" ;; FIXME: %2 is an illegal specifier
62+
%7) "
63+
"(fn [_ _ _ _ _ _ id] (format \"%2\" ;; FIXME: %2 is an illegal specifier
64+
id)) "
65+
(setq names '("_" "_" "_" "_" "_" "_" "id"))
66+
(clojure-promote-fn-literal)))
67+
68+
69+
(provide 'clojure-mode-convert-fn-test)
70+
71+
72+
;;; clojure-mode-promote-fn-literal-test.el ends here

0 commit comments

Comments
 (0)