From: Eshel Yaron Date: Sat, 8 Jun 2024 19:40:23 +0000 (+0200) Subject: Add hook 'refactor-replacement-functions' X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=e0f08a92ce513e7e2939da70f2ff4a6d16c0424f;p=emacs.git Add hook 'refactor-replacement-functions' --- diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index 2dad6864429..9f4739dc7d8 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -3757,7 +3757,7 @@ edit proposed by the server." (pcase (with-current-buffer buf (eglot-range-region range)) (`(,beg . ,end) - (list beg end newText nil nil)))) + (list beg end newText)))) edits)))) prepared)))) diff --git a/lisp/progmodes/refactor-simple.el b/lisp/progmodes/refactor-simple.el index 2ee70fbb717..58515a0ee97 100644 --- a/lisp/progmodes/refactor-simple.el +++ b/lisp/progmodes/refactor-simple.el @@ -37,7 +37,7 @@ (without-restriction (goto-char (point-min)) (while (search-forward old nil t) - (push (list (match-beginning 0) (match-end 0) new nil nil) edits)))) + (push (list (match-beginning 0) (match-end 0) new) edits)))) (cons (current-buffer) edits)))) (cl-defmethod refactor-backend-rename-edits ((_backend (eql simple)) old new @@ -55,7 +55,7 @@ ;;;###autoload (define-minor-mode refactor-simple-mode - "Use the dummy backend for refactoring operations." + "Simple backend for refactoring operations." :group 'refactor :global t (if refactor-simple-mode diff --git a/lisp/progmodes/refactor.el b/lisp/progmodes/refactor.el index ed464790411..e9bd67185d6 100644 --- a/lisp/progmodes/refactor.el +++ b/lisp/progmodes/refactor.el @@ -120,8 +120,6 @@ operations that BACKEND supports.") (refactor-apply-edits (refactor-backend-rename-edits backend old new scope)))))) -;; (defun refactor-indicate-suggestions () ...) - (defun refactor-read-operation-multiple-choice (operations) (intern (cadr (read-multiple-choice "Refactor operation:" (mapcar (pcase-lambda (`(,op . ,_)) @@ -179,18 +177,19 @@ Otherwise, if the replacement is valid, return nil." (cl-defgeneric refactor-backend-rename-edits (backend old new scope) "Return alist of edits for renaming OLD to NEW across SCOPE using BACKEND. -Each element is a cons cell (FILE-OR-BUFFER . EDITS), where -FILE-OR-BUFFER is the file name or buffer to edit, and EDITS is a list -of edits to perform in FILE-OR-BUFFER. Each element of EDITS is a -list (BEG END STR ID ANN), where BEG and END are buffer positions to -delete and STR is the string to insert at BEG afterwards. ID is a -BACKEND-specific edit identifier, and ANN is an optional annotation -associated with this edit. Depending on the value of -`refactor-apply-edits-function', `refactor-rename' may display ANN when -applying the relevant edit.") - -(defun refactor--apply-edits (edits) - (pcase-dolist (`(,beg ,end ,str . ,_) (sort edits :key #'cadr :reverse t)) +See `refactor-apply-edits' for the format of the return value.") + +(defvar refactor-replacement-functions nil + "Abnormal hook for tracking text replacements in refactor operations. + +The value of this variable is a list of functions. +`refactor-apply-edits' calls each of these functions with one argument +after applying a text replacement as part of a refactor operation. The +argument is the token corresponding to that text replacement.") + +(defun refactor--apply-replacements (reps) + "Apply text replacements REPS in the current buffer." + (pcase-dolist (`(,beg ,end ,str ,token) (sort reps :key #'cadr :reverse t)) (let ((source (current-buffer))) (with-temp-buffer (insert str) @@ -199,7 +198,8 @@ applying the relevant edit.") (save-excursion (save-restriction (narrow-to-region beg end) - (replace-buffer-contents temp))))))))) + (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." @@ -207,13 +207,19 @@ applying the relevant edit.") (let ((file-or-buffer (car edit))) (unless (bufferp file-or-buffer) (setcar edit (find-file-noselect file-or-buffer))))) - (dolist (buffer-changes edits) - (with-current-buffer (car buffer-changes) + (dolist (buffer-reps edits) + (with-current-buffer (car buffer-reps) (atomic-change-group (let* ((change-group (prepare-change-group))) - (refactor--apply-edits (cdr buffer-changes)) + (refactor--apply-replacements (cdr buffer-reps)) (undo-amalgamate-change-group change-group)))))) +(defun refactor-run-replacement-functions-from-diff (buf &rest _) + (let ((tokens (get-text-property (point) 'refactor-replacement-tokens))) + (with-current-buffer buf + (dolist (token tokens) + (run-hook-with-args 'refactor-replacement-functions token))))) + (defun refactor-display-edits-as-diff (edits) "Display EDITS as a diff." (dolist (edit edits) @@ -227,14 +233,24 @@ applying the relevant edit.") (let ((inhibit-read-only t) (target (current-buffer))) (erase-buffer) - (pcase-dolist (`(,file . ,changes) edits) - (with-temp-buffer - (let* ((diff (current-buffer))) - (with-temp-buffer - (insert-file-contents file) - (refactor--apply-edits changes) - (diff-no-select file (current-buffer) nil t diff)) - (with-current-buffer target (insert-buffer-substring diff)))))) + (pcase-dolist (`(,file . ,reps) edits) + (when (and reps file (file-readable-p file)) + (with-temp-buffer + (let ((diff (current-buffer)) + (tokens nil)) + (with-temp-buffer + (insert-file-contents file) + (let ((refactor-replacement-functions + (list (lambda (token) (push token tokens))))) + (refactor--apply-replacements reps)) + (diff-no-select file (current-buffer) nil t diff)) + (with-current-buffer target + (let ((start (point))) + (insert-buffer-substring diff) + (put-text-property start (point) + 'refactor-replacement-tokens tokens)))))))) + (add-hook 'diff-apply-hunk-functions + #'refactor-run-replacement-functions-from-diff nil t) (buffer-enable-undo (current-buffer)) (goto-char (point-min)) (pop-to-buffer (current-buffer)) @@ -245,7 +261,16 @@ applying the relevant edit.") "Apply EDITS. Call the function specified by `refactor-apply-edits-function' to -do the work." +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 +applications of this replacement via `refactor-replacement-functions', +which see." (funcall refactor-apply-edits-function edits)) (provide 'refactor) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index c0269d882b9..5e74bc381ba 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1968,6 +1968,13 @@ SWITCHED is non-nil if the patch is already applied." (t "Hunk %s at offset %d lines")) msg line-offset))) +(defvar diff-apply-hunk-functions nil + "Abnormal hook run when applying a Diff hunk. + +Functions on this hook are called with point at the applied hunk and +should take six arguments, corresponding to the elements of the return +value of `diff-find-source-location' in this hunk.") + (defvar diff-apply-hunk-to-backup-file nil) (defun diff-apply-hunk (&optional reverse) @@ -2018,6 +2025,8 @@ With a prefix argument, REVERSE the hunk." (message "(Nothing done)")) (t ;; Apply the hunk + (run-hook-with-args 'diff-apply-hunk-functions + buf line-offset pos old new switched) (with-current-buffer buf (goto-char (car pos)) (delete-region (car pos) (cdr pos)) @@ -2059,11 +2068,13 @@ When applying all hunks was successful, then save the changed buffers." (save-excursion (goto-char (point-min)) (diff-beginning-of-hunk t) - (while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched) + (while (pcase-let ((`(,buf ,line-offset ,pos ,src ,dst ,switched) (diff-find-source-location nil nil))) (cond ((and line-offset (not switched)) (push (cons pos dst) - (alist-get buf buffer-edits))) + (alist-get buf buffer-edits)) + (run-hook-with-args 'diff-apply-hunk-functions + buf line-offset pos src dst switched)) (t (setq failures (1+ failures)))) (and (not (eq (prog1 (point) (ignore-errors (diff-hunk-next))) (point)))