From 33cd93e3691a0e951acfc81eb7364c36ae56e02a Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 10 Jul 2024 16:30:11 +0200 Subject: [PATCH] New function 'refactor-query-apply-edits' --- lisp/progmodes/refactor.el | 118 +++++++++++++++++++++++++++++++------ 1 file changed, 101 insertions(+), 17 deletions(-) diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el index e9bd67185d6..43203c34da7 100644 --- a/lisp/progmodes/refactor.el +++ b/lisp/progmodes/refactor.el @@ -22,11 +22,9 @@ ;; Generic refactoring UI and API. -;;; TODO +;;; TODO: ;; - Add a menu bar menu and a prefix keymap. -;; - Support custom backend operations. (Don't hardcode permitted operations.) - ;;; Code: @@ -35,10 +33,18 @@ :group 'programming) (defcustom refactor-apply-edits-function #'refactor-apply-edits-at-once - "Function to use for applying edits during refactoring." + "Function to use for applying edits during refactoring. + +`refactor-apply-edits' calls this function with one argument, a list of +cons cells (BUFFER . REPS), where BUFFER is the buffer to edit, and REPS +is a list of replacements to perform in BUFFER. Each element of REPS is +a list (BEG END STR TOKEN) describing a replacement in BUFFER, where BEG +and END are buffer positions to delete and STR is the string to insert +at BEG afterwards. If this function applies a replacement, it should +run hook `refactor-replacement-functions' with the corresponding TOKEN +as an argument while BUFFER is current." :type '(choice (const :tag "Apply edits at once" refactor-apply-edits-at-once) - ;; TODO: - ;; (const :tag "Query about each edit" refactor-query-apply-edits) + (const :tag "Query about each edit" refactor-query-apply-edits) (const :tag "Display edits as diff" refactor-display-edits-as-diff) (function :tag "Custom function"))) @@ -109,7 +115,9 @@ operations that BACKEND supports.") ;;;###autoload (defun refactor-rename (backend) - (interactive (list (refactor-backend-for-operation 'rename))) + (interactive (list + (or (refactor-backend-for-operation 'rename) + (user-error "No appropriate refactor backend available")))) (pcase (refactor-backend-read-scoped-identifier backend) (`(,old . ,scope) (let ((new (refactor-backend-read-replacement backend old scope))) @@ -118,6 +126,7 @@ operations that BACKEND supports.") (cons ?n new) (cons ?s (or scope "current scope"))))) (refactor-apply-edits + ;; TODO: Maybe `save-some-buffers' first? (refactor-backend-rename-edits backend old new scope)))))) (defun refactor-read-operation-multiple-choice (operations) @@ -201,12 +210,14 @@ argument is the token corresponding to that text replacement.") (replace-buffer-contents temp))) (run-hook-with-args 'refactor-replacement-functions token))))))) -(defun refactor-apply-edits-at-once (edits) - "Apply EDITS at once, without confirmation." +(defun refactor--find-edit-buffers (edits) (dolist (edit edits) (let ((file-or-buffer (car edit))) (unless (bufferp file-or-buffer) - (setcar edit (find-file-noselect file-or-buffer))))) + (setcar edit (find-file-noselect file-or-buffer)))))) + +(defun refactor-apply-edits-at-once (edits) + "Apply EDITS at once, without confirmation." (dolist (buffer-reps edits) (with-current-buffer (car buffer-reps) (atomic-change-group @@ -222,10 +233,6 @@ argument is the token corresponding to that text replacement.") (defun refactor-display-edits-as-diff (edits) "Display EDITS as a diff." - (dolist (edit edits) - (let ((file-or-buffer (car edit))) - (when (bufferp file-or-buffer) - (setcar edit (buffer-file-name file-or-buffer))))) (with-current-buffer (get-buffer-create "*Refactor Diff*") (buffer-disable-undo (current-buffer)) (setq buffer-read-only t) @@ -256,6 +263,82 @@ argument is the token corresponding to that text replacement.") (pop-to-buffer (current-buffer)) (font-lock-ensure))) +(defcustom refactor-query-apply-display-buffer-action nil + "`display-buffer' action to show a buffer when querying about editing it." + :type '(cons (choice function (repeat :tag "Functions" function)) alist)) + +(defun refactor--query-apply-buffer-reps (buffer reps) + "Suggest applying replacements REPS in BUFFER." + (if-let ((win (display-buffer buffer refactor-query-apply-display-buffer-action))) + (with-selected-window win + (dolist (rep reps) + (setcar rep (copy-marker (car rep))) + (setcar (cdr rep) (copy-marker (cadr rep))) + (let ((ov (make-overlay (car rep) (cadr rep)))) + (overlay-put ov 'face '(obsolete diff-refine-removed)) + (overlay-put ov 'after-string (propertize (caddr rep) 'face 'diff-added)) + (overlay-put ov 'window (selected-window)) + (if-let ((cell (cdddr rep))) + (setcdr cell ov) + (setcdr (cddr rep) (cons nil ov))))) + (unwind-protect + (while reps + (pcase (car reps) + (`(,beg ,end ,str ,token . ,ov) + (save-excursion + (overlay-put ov 'after-string (propertize str 'face 'diff-refine-added)) + (set-window-point (selected-window) end) + (when (prog1 + (pcase (car (read-multiple-choice + "Apply?" + '((?y "yes" "Apply") + (?n "no" "Skip") + (?q "quit" "Quit") + (?! "all" "Apply to all")))) + (?y t) + (?n nil) + (?q (throw 'stop nil)) + (?! (throw 'stop (cons 'all reps)))) + (delete-overlay ov)) + (let ((source (current-buffer))) + (with-temp-buffer + (insert str) + (let ((temp (current-buffer))) + (with-current-buffer source + (save-excursion + (save-restriction + (narrow-to-region beg end) + (replace-buffer-contents temp))) + (run-hook-with-args + 'refactor-replacement-functions token))))))))) + (setq reps (cdr reps))) + (pcase-dolist (`(,_ ,_ ,_ ,_ . ,ov) reps) + (when (overlayp ov) (delete-overlay ov))))) + (error "Failed to display buffer `%s' for applying edits" + (buffer-name buffer)))) + +(defun refactor-query-apply-edits (edits) + "Suggest applying each edit in EDITS in turn." + (let ((change-group (mapcan (compose #'prepare-change-group #'car) edits)) + (undo-outer-limit nil) + (undo-limit most-positive-fixnum) + (undo-strong-limit most-positive-fixnum) + (success nil)) + (unwind-protect + (progn + (activate-change-group change-group) + (pcase (catch 'stop + (while edits + (let ((buffer-reps (car edits))) + (refactor--query-apply-buffer-reps + (car buffer-reps) (cdr buffer-reps)) + (setq edits (cdr edits))))) + (`(all . ,reps) + (setcdr (car edits) reps) + (refactor-apply-edits-at-once edits))) + (setq success t)) + (funcall (if success #'accept-change-group #'cancel-change-group) change-group)))) + ;;;###autoload (defun refactor-apply-edits (edits) "Apply EDITS. @@ -266,11 +349,12 @@ do the work. EDITS is list of cons cells (FILE-OR-BUFFER . REPS), where FILE-OR-BUFFER is the file name or buffer to edit, and REPS is a list of replacements to perform in FILE-OR-BUFFER. Each element of REPS is a -list (BEG END STR TOKEN), where BEG and END are buffer positions to -delete and STR is the string to insert at BEG afterwards. TOKEN is an -arbitrary object that a refactor backend can provide in order to track +list (BEG END STR TOKEN), where BEG and END are positions to delete and +STR is the string to insert at BEG afterwards. TOKEN is an arbitrary +object that a refactor backend can provide in order to track applications of this replacement via `refactor-replacement-functions', which see." + (refactor--find-edit-buffers edits) (funcall refactor-apply-edits-function edits)) (provide 'refactor) -- 2.39.2