Enhance add arity refactoring (#541)

Support reader conditionals, letfn, fn, defmacro, defmethod, defprotocol, reify
and proxy in addition to defn.

Author: anthonygalea

CHANGELOG.md

@@ -5,6 +5,11 @@
 ### Bugs fixed
 
 * [#520](https://github.com/clojure-emacs/clojure-mode/issues/508): Fix allow `clojure-align-cond-forms` to recognize qualified forms.
+* Enhance add arity refactoring to support a defn inside a reader conditional.
+
+### Changes
+
+* Enhance add arity refactoring to support new forms: letfn, fn, defmacro, defmethod, defprotocol, reify and proxy.
 
 ## 5.11.0 (2019-07-16)
 

clojure-mode.el

@@ -2738,37 +2738,80 @@ With a numeric prefix argument the let is introduced N lists up."
               (clojure--rename-ns-alias-internal current-alias new-alias))
           (message "Cannot find namespace alias: '%s'" current-alias))))))
 
-;;;###autoload
-(defun clojure-add-arity ()
-  "Add an arity to a function."
-  (interactive)
-  (let ((end (save-excursion (end-of-defun)
-                             (point)))
-        (beg (progn (beginning-of-defun)
-                    (point))))
+(defun clojure--add-arity-defprotocol-internal ()
+  "Add an arity to a signature inside a defprotocol.
+
+Assumes cursor is at beginning of signature."
+  (re-search-forward "\\[")
+  (save-excursion (insert "] [")))
+
+(defun clojure--add-arity-reify-internal ()
+  "Add an arity to a function inside a reify.
+
+Assumes cursor is at beginning of function."
+  (re-search-forward "\\(\\w+ \\)")
+  (insert "[")
+  (save-excursion (insert "])\n(" (match-string 0))))
+
+(defun clojure--add-arity-internal ()
+  "Add an arity to a function.
+
+Assumes cursor is at beginning of function."
+  (let ((beg-line (what-line))
+        (end (save-excursion (forward-sexp)
+                             (point))))
     (down-list 2)
     (when (looking-back "{" 1) ;; skip metadata if present
       (up-list)
       (down-list))
     (cond
-     ((looking-back "(" 1) ;; multi-arity defn
+     ((looking-back "(" 1) ;; multi-arity fn
       (insert "[")
-      (save-excursion (insert "])\n("))
-      (indent-region beg end))
-     ((looking-back "\\[" 1)  ;; single-arity defn
-      (let* ((bol (save-excursion (beginning-of-line) (point)))
-             (same-line (save-excursion (re-search-backward "defn" bol t)))
-             (new-arity-text (concat (when same-line "\n") "([])\n[")))
-        (re-search-backward " +\\[")
-        (replace-match new-arity-text)
+      (save-excursion (insert "])\n(")))
+     ((looking-back "\\[" 1)  ;; single-arity fn
+      (let* ((same-line (string= beg-line (what-line)))
+             (new-arity-text (concat (when same-line "\n") "([")))
         (save-excursion
-          (end-of-defun)
-          (re-search-backward ")")
+          (goto-char end)
           (insert ")"))
-        (left-char)
-        (insert "(")
-        (indent-region beg end)
-        (left-char 6))))))
+
+        (re-search-backward " +\\[")
+        (replace-match new-arity-text)
+        (save-excursion (insert "])\n([")))))))
+
+;;;###autoload
+(defun clojure-add-arity ()
+  "Add an arity to a function."
+  (interactive)
+  (let ((original-pos (point))
+        (n 0))
+    (while (not (looking-at-p "(\\(defn\\|letfn\\|fn\\|defmacro\\|defmethod\\|defprotocol\\|reify\\|proxy\\)"))
+      (setq n (1+ n))
+      (backward-up-list 1 t))
+    (let ((beg (point))
+          (end-marker (make-marker))
+          (end (save-excursion (forward-sexp)
+                               (point)))
+          (jump-up (lambda (x)
+                     (goto-char original-pos)
+                     (backward-up-list x t))))
+      (set-marker end-marker end)
+      (cond
+       ((looking-at-p "(\\(defn\\|fn\\|defmethod\\|defmacro\\)")
+        (clojure--add-arity-internal))
+       ((looking-at-p "(letfn")
+        (funcall jump-up (- n 2))
+        (clojure--add-arity-internal))
+       ((looking-at-p "(proxy")
+        (funcall jump-up (- n 1))
+        (clojure--add-arity-internal))
+       ((looking-at-p "(defprotocol")
+        (funcall jump-up (- n 1))
+        (clojure--add-arity-defprotocol-internal))
+       ((looking-at-p "(reify")
+        (funcall jump-up (- n 1))
+        (clojure--add-arity-reify-internal)))
+      (indent-region beg end-marker))))
 
 
 ;;; ClojureScript

test/clojure-mode-refactor-add-arity-test.el

@@ -149,6 +149,202 @@ DESCRIPTION is a string with the description of the spec."
   ([arg]
    body))"
 
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a single-arity fn"
+    "(fn foo [arg]
+  body|)"
+
+    "(fn foo
+  ([|])
+  ([arg]
+   body))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a multi-arity fn"
+    "(fn foo
+  ([x y]
+   body)
+  ([a|rg]
+   body))"
+
+    "(fn foo
+  ([|])
+  ([x y]
+   body)
+  ([arg]
+   body))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a single-arity defmacro"
+    "(defmacro foo [arg]
+  body|)"
+
+    "(defmacro foo
+  ([|])
+  ([arg]
+   body))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a multi-arity defmacro"
+    "(defmacro foo
+  ([x y]
+   body)
+  ([a|rg]
+   body))"
+
+    "(defmacro foo
+  ([|])
+  ([x y]
+   body)
+  ([arg]
+   body))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a single-arity defmethod"
+    "(defmethod foo :bar [arg]
+  body|)"
+
+    "(defmethod foo :bar
+  ([|])
+  ([arg]
+   body))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a multi-arity defmethod"
+    "(defmethod foo :bar
+  ([x y]
+   body)
+  ([a|rg]
+   body))"
+
+    "(defmethod foo :bar
+  ([|])
+  ([x y]
+   body)
+  ([arg]
+   body))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a defn inside a reader conditional"
+    "#?(:clj
+   (defn foo
+     \"some docstring\"
+     ^{:bla \"meta\"}
+     |([arg]
+      body)))"
+
+    "#?(:clj
+   (defn foo
+     \"some docstring\"
+     ^{:bla \"meta\"}
+     ([|])
+     ([arg]
+      body)))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a defn inside a reader conditional with 2 platform tags"
+    "#?(:clj
+   (defn foo
+     \"some docstring\"
+     ^{:bla \"meta\"}
+     |([arg]
+      body))
+   :cljs
+   (defn foo
+     \"some docstring\"
+     ^{:bla \"meta\"}
+     ([arg]
+      body)))"
+
+    "#?(:clj
+   (defn foo
+     \"some docstring\"
+     ^{:bla \"meta\"}
+     ([|])
+     ([arg]
+      body))
+   :cljs
+   (defn foo
+     \"some docstring\"
+     ^{:bla \"meta\"}
+     ([arg]
+      body)))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a single-arity fn inside a letfn"
+    "(letfn [(foo [x]
+           bo|dy)]
+  (foo 3))"
+
+    "(letfn [(foo
+          ([|])
+          ([x]
+           body))]
+  (foo 3))"
+
+    (clojure-add-arity))
+
+    (when-refactoring-with-point-it "should handle a multi-arity fn inside a letfn"
+    "(letfn [(foo
+          ([x]
+           body)
+          |([x y]
+           body))]
+  (foo 3))"
+
+    "(letfn [(foo
+          ([|])
+          ([x]
+           body)
+          ([x y]
+           body))]
+  (foo 3))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a proxy"
+    "(proxy [Foo] []
+  (bar [arg]
+     body|))"
+
+    "(proxy [Foo] []
+  (bar
+    ([|])
+    ([arg]
+     body)))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a defprotocol"
+    "(defprotocol Foo
+  \"some docstring\"
+  (bar [arg] [x |y] \"some docstring\"))"
+
+    "(defprotocol Foo
+  \"some docstring\"
+  (bar [|] [arg] [x y] \"some docstring\"))"
+
+    (clojure-add-arity))
+
+  (when-refactoring-with-point-it "should handle a reify"
+    "(reify Foo
+  (bar [arg] body)
+  (blahs [arg]| body))"
+
+    "(reify Foo
+  (bar [arg] body)
+  (blahs [|])
+  (blahs [arg] body))"
+
     (clojure-add-arity)))
 
 (provide 'clojure-mode-refactor-add-arity-test)