New 'extract' refactor operation

Generalizes 'elisp-extract'

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index c3f7deff603363966cf3dba29cbab7dea18248f7..82c92593d2ad5bd3527ae4a31eabbacffcf8417d 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -58,7 +58,6 @@ All commands in `lisp-mode-shared-map' are inherited by this map."
   "C-c C-b" #'elisp-byte-compile-buffer
   "C-M-q" #'indent-pp-sexp
   "C-c M-e" #'macrostep-expand
-  "C-c C-x" #'elisp-extract
   "C-c C-n" #'elisp-next-occurrence
   "C-c C-p" #'elisp-prev-occurrence)
 
@@ -2367,39 +2366,6 @@ interactively, this is the prefix argument."
   "C-n" #'elisp-next-occurrence
   "C-p" #'elisp-prev-occurrence)
 
-(defun elisp-extract (beg end new)
-  "Extract region from BEG to END into NEW function."
-  ;; FIXME:
-  ;; - Check that region is a valid form.
-  ;; - Handle Local function bindings (e.g. `named-let').
-  ;; - Group buffer changes together.
-  ;; - Order bound variables by their binding positions.
-  (interactive
-   (if (use-region-p)
-       (list (use-region-beginning)
-             (use-region-end)
-             (let ((def (when-let ((d (which-function))) (concat d "-1"))))
-               (read-string (format-prompt "Function name" def) nil nil def)))
-     (user-error "No region selected"))
-   emacs-lisp-mode)
-  (let* (bound-vars)
-    (save-excursion
-      (goto-char beg)
-      (beginning-of-defun)
-      (scope (lambda (_type sbeg len bin)
-               (and (<= beg sbeg (+ sbeg len) end) (numberp bin) (< bin beg)
-                    (cl-pushnew (intern (buffer-substring sbeg (+ sbeg len)))
-                                bound-vars))))
-      (insert "\n\n(defun " new " (" (mapconcat #'symbol-name bound-vars " ") ")" "\n")
-      (indent-according-to-mode)
-      (push-mark nil t)
-      (insert (string-trim (buffer-substring beg end)) ")")
-      (prog-indent-sexp 'defun)
-      (goto-char beg)
-      (delete-region beg end)
-      (insert "(" new " " (mapconcat #'symbol-name bound-vars " ") ")")
-      (prog-indent-sexp 'defun))))
-
 \f
 (put 'read-symbol-shorthands 'safe-local-variable #'consp)
 

diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el
index 737c0707dd0d00956f4fb5da5565fc0c1cf271e1..13c23ce073e7a896a834bbf91daf3938e0b232a0 100644 (file)
--- a/lisp/progmodes/refactor-elisp.el
+++ b/lisp/progmodes/refactor-elisp.el
@@ -27,7 +27,7 @@
 (require 'refactor)
 
 ;;;###autoload
-(defun elisp-refactor-backend () '(elisp rename))
+(defun elisp-refactor-backend () '(elisp rename extract))
 
 (cl-defmethod refactor-backend-read-scoped-identifier ((_backend (eql elisp)))
   (let* ((pos (point)))
@@ -81,5 +81,55 @@
             (alist-set beg res (+ beg len))))
         res))))
 
+(cl-defmethod refactor-backend-extract-validate-region
+  ((_backend (eql elisp)) beg end)
+  (unless (ignore-errors (read (buffer-substring beg end)) t)
+    "syntactically invalid"))
+
+(cl-defmethod refactor-backend-extract-edits
+  ((_backend (eql elisp)) beg end new)
+  (save-excursion
+    ;; TODO:
+    ;; - Handle local function bindings (e.g. `named-let').
+    ;; - Remove redundant `progn' around extracted forms.
+    ;; - Find more occurrences of extracted form, maybe with el-search.
+    ;; - Extract form to local/global variable.
+    (goto-char beg)
+    (skip-chars-forward "[:blank:]\n")
+    (beginning-of-defun-raw)
+    (let (bound)
+      (scope (lambda (_type sbeg len bin)
+               (let ((send (+ sbeg len)))
+                 (and (<= beg sbeg send end) (numberp bin) (< bin beg)
+                      (unless (assoc bin bound #'=)
+                        (push (cons bin (buffer-substring-no-properties
+                                         sbeg send))
+                              bound))))))
+      (let* ((buf (current-buffer)) (pos (point))
+             (vstr (mapconcat #'cdr (sort bound) " "))
+             (beg (progn
+                    (goto-char beg)
+                    (skip-chars-forward "[:blank:]\n")
+                    (point)))
+             (end (progn
+                    (goto-char end)
+                    (skip-chars-backward "[:blank:]\n")
+                    (point)))
+             (newf (with-temp-buffer
+                     (insert-buffer-substring buf)
+                     (emacs-lisp-mode)
+                     (goto-char pos)
+                     (insert "\n\n(defun " new " (" vstr ")" "\n")
+                     (insert (string-trim (buffer-substring beg end)))
+                     (when (nth 4 (syntax-ppss)) (insert "\n"))
+                     (insert ")")
+                     (prog-indent-sexp 'defun)
+                     (buffer-substring pos (point)))))
+        `((,buf
+           ;; Add `new' function definition at `pos'.
+           (,pos ,pos ,newf)
+           ;; Replace `beg'-`end' region with call to `new' function.
+           (,beg ,end ,(concat "(" new (when bound " ") vstr ")"))))))))
+
 (provide 'refactor-elisp)
 ;;; refactor-elisp.el ends here

diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el
index e74ed16d680284988a8db2f7721c1e9c662ebc53..fa654b513b2381b431e4e6f867dde44302f861f7 100644 (file)
--- a/lisp/progmodes/refactor.el
+++ b/lisp/progmodes/refactor.el
@@ -100,8 +100,8 @@ operations that BACKEND supports.")
      (list op (car (alist-get op op-be-alist)))))
   (pcase operation
     ('rename (refactor-rename backend))
+    ('extract (refactor-extract backend))
     ;; TODO:
-    ;; ('extract (refactor-extract backend))
     ;; ('inline (refactor-inline backend))
     ;; ('organize (refactor-organize backend))
     ;; ('simplify (refactor-simplify backend))
@@ -113,6 +113,21 @@ operations that BACKEND supports.")
 (defun refactor-backend-for-operation (op)
   (car (alist-get op (refactor-backends))))
 
+;;;###autoload
+(defun refactor-extract (backend)
+  (interactive (list
+                (or (refactor-backend-for-operation 'extract)
+                    (user-error "No appropriate refactor backend available"))))
+  (unless (use-region-p) (user-error "No active region"))
+  (let ((beg (region-beginning)) (end (region-end)))
+    (when-let ((err (refactor-backend-extract-validate-region backend beg end)))
+      (user-error "Cannot extract region: %s" err))
+    (deactivate-mark)
+    (refactor-apply-edits
+     (refactor-backend-extract-edits
+      backend (region-beginning) (region-end)
+      (refactor-backend-read-new-function-name backend)))))
+
 ;;;###autoload
 (defun refactor-rename (backend)
   (interactive (list
@@ -191,6 +206,23 @@ Otherwise, if the replacement is valid, return nil."
         new)
     (remove-overlays (point-min) (point-max) 'refactor-rename-old t)))
 
+(cl-defgeneric refactor-backend-read-new-function-name (_backend)
+  "Read a new function name."
+  (let ((def (when-let ((d (which-function))) (concat d "-1"))))
+    (read-string (format-prompt "Extract region to function called" def)
+                 nil nil def)))
+
+(cl-defgeneric refactor-backend-extract-validate-region (backend beg end)
+  "Check if BEG to END region can be extracted to new function with BACKEND.
+
+Return nil if the region is valid, or a string that explains why the
+region is not valid.")
+
+(cl-defgeneric refactor-backend-extract-edits (backend beg end new)
+  "Return edits for extracting BEG to END region to NEW function using BACKEND.
+
+See `refactor-apply-edits' for the format of the return value.")
+
 (cl-defgeneric refactor-backend-rename-edits (backend old new scope)
   "Return alist of edits for renaming OLD to NEW across SCOPE using BACKEND.