From 1585f34812176b12965727511ffe1259459afbe9 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 15 Jan 2025 13:44:47 +0100 Subject: [PATCH] New 'extract' refactor operation Generalizes 'elisp-extract' --- lisp/progmodes/elisp-mode.el | 34 --------------------- lisp/progmodes/refactor-elisp.el | 52 +++++++++++++++++++++++++++++++- lisp/progmodes/refactor.el | 34 ++++++++++++++++++++- 3 files changed, 84 insertions(+), 36 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index c3f7deff603..82c92593d2a 100644 --- 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)))) - (put 'read-symbol-shorthands 'safe-local-variable #'consp) diff --git a/lisp/progmodes/refactor-elisp.el b/lisp/progmodes/refactor-elisp.el index 737c0707dd0..13c23ce073e 100644 --- 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 e74ed16d680..fa654b513b2 100644 --- 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. -- 2.39.5