New function 'refactor-query-apply-edits'

diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el
index e9bd67185d614c528ad776d8d68812835a11c2ae..43203c34da73b4ae7693e452d4b1164c4df3c861 100644 (file)
--- 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)