From ff9c8fd5545ee9bdd36d51ae865be14ea5f4ac26 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Wed, 15 Jan 2025 00:06:13 +0100
Subject: [PATCH] New command 'elisp-extract'

---
 lisp/progmodes/elisp-mode.el     | 34 ++++++++++++++++++++++++++++++++
 lisp/progmodes/refactor-elisp.el |  9 +++------
 lisp/progmodes/which-func.el     |  1 +
 3 files changed, 38 insertions(+), 6 deletions(-)

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 82c92593d2a..c3f7deff603 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -58,6 +58,7 @@ 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)
 
@@ -2366,6 +2367,39 @@ 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))))
+
 
 (put 'read-symbol-shorthands 'safe-local-variable #'consp)
 
diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el
index 10ecab64925..737c0707dd0 100644
--- a/lisp/progmodes/refactor-elisp.el
+++ b/lisp/progmodes/refactor-elisp.el
@@ -41,8 +41,7 @@
                      (throw 'var-def
                             (list (propertize
                                    (buffer-substring-no-properties beg (+ beg len))
-                                   'pos beg)))))
-                 (current-buffer))
+                                   'pos beg))))))
           nil)))))
 
 (cl-defmethod refactor-backend-rename-edits
@@ -55,8 +54,7 @@
       (scope (lambda (_type beg len bin)
                (when (<= beg pos (+ beg len))
                  (setq dec bin))
-               (when bin (push (list beg len bin) all)))
-             (current-buffer)))
+               (when bin (push (list beg len bin) all)))))
     (list
      (cons (current-buffer)
            (let (res)
@@ -75,8 +73,7 @@
       (scope (lambda (_type beg len bin)
                (when (<= beg pos (+ beg len))
                  (setq dec bin))
-               (when bin (push (list beg len bin) all)))
-             (current-buffer)))
+               (when bin (push (list beg len bin) all)))))
     (when dec
       (let (res)
         (pcase-dolist (`(,beg ,len ,bin) all)
diff --git a/lisp/progmodes/which-func.el b/lisp/progmodes/which-func.el
index 7bd1bf44ebc..eb3c0d51b08 100644
--- a/lisp/progmodes/which-func.el
+++ b/lisp/progmodes/which-func.el
@@ -321,6 +321,7 @@ in certain major modes."
 It calls them sequentially, and if any returns non-nil,
 `which-function' uses that name and stops looking for the name.")
 
+;;;###autoload
 (defun which-function ()
   "Return current function name based on point.
 Uses `which-func-functions', `add-log-current-defun'.
-- 
2.39.5