From 208e80018a7cdc87b35c7f8a08a243600c54c9cc Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Thu, 4 Sep 2025 11:25:25 +0100 Subject: New commands to apply changes to other working trees * lisp/vc/diff-mode.el (diff-apply-buffer): New TEST argument. * lisp/vc/vc.el (diff-apply-buffer): Declare. (vc-no-confirm-moving-changes): New user option. (vc-apply-to-other-working-tree) (vc-apply-root-to-other-working-tree): New commands. * lisp/vc/vc-hooks.el (vc-prefix-map): Bind them. * doc/emacs/vc1-xtra.texi (Other Working Trees): * etc/NEWS: Document them. --- doc/emacs/vc1-xtra.texi | 52 ++++++++++++++--- etc/NEWS | 2 + lisp/vc/diff-mode.el | 50 +++++++++------- lisp/vc/vc-hooks.el | 4 +- lisp/vc/vc.el | 151 ++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 227 insertions(+), 32 deletions(-) diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi index b5a0f0c129b..15b7a73e5d7 100644 --- a/doc/emacs/vc1-xtra.texi +++ b/doc/emacs/vc1-xtra.texi @@ -397,15 +397,15 @@ want to disturb. So you type @kbd{C-x v w c} (see below) and create a new working tree, following the prompts to check out the version 2 branch there. -You apply the patch to that working tree, build and test it. Satisfied, -you use @kbd{C-x v P} (@pxref{Pulling / Pushing}) in the other working -tree. In the course of testing the patch, you've realised that the bug -exists in version 3 of the software, too. So you switch back to your -first working tree, and use @kbd{C-x v m} (@pxref{Merging}) to merge the -branch you have checked out in the other working tree. Now your version -of the trunk has all of version 2's fixes merged into it, but you -haven't pushed it yet because you're still refactoring. You'll use -@kbd{C-x v P} later. +You apply the patch to that working tree using @w{@kbd{C-x v w a}} (see +below), build and test it. Satisfied, you use @w{@kbd{C-x v P}} +(@pxref{Pulling / Pushing}) in the other working tree. In the course of +testing the patch, you've realised that the bug exists in version 3 of +the software, too. So you switch back to your first working tree, and +use @kbd{C-x v m} (@pxref{Merging}) to merge the branch you have checked +out in the other working tree. Now your version of the trunk has all of +version 2's fixes merged into it, but you haven't pushed it yet because +you're still refactoring. You'll use @kbd{C-x v P} later. @end indentedblock Ordinary VC commands like @kbd{C-x v v} (@pxref{Basic VC Editing}) and @@ -440,6 +440,12 @@ Visit this file or directory in another working tree. Invoke @kbd{C-x p p} (@code{project-switch-project}) but limited to other working trees. +@item C-x v w a +Copy or move fileset changes to another working tree. + +@item C-x v w A +Copy or move all changes to another working tree. + @item C-x v w x Delete a working tree you no longer need. @@ -500,6 +506,34 @@ to other working trees. The main difference between @kbd{C-x v w w} and buffer in the other working tree while the latter considers the other working tree as a whole, independent project. +@kindex C-x v w a +@findex vc-apply-to-other-working-tree +The command @kbd{C-x v w a} (@code{vc-apply-to-other-working-tree}) +prompts you to select a working tree, then copies changes from the +current working tree to that other working tree. With a prefix +argument, it moves changes instead of just copying them. Usually the +command operates on local (uncommitted) changes to the current VC +fileset. When invoked in a Diff mode (@pxref{Diff Mode}) buffer, it +operates on the changes specified by the contents of that buffer. The +command stops and does nothing if any of the changes don't apply. + +@kbd{C-x v w a} is useful to copy changes to a temporary working tree in +order to test them. It is also useful to copy fixes back to your main +working tree for checking in. For example, you might hack away at a bug +in a temporary working tree, and fix it. You'd then want to copy or +move the fix back to your main working tree to check it in and push it. + +@kindex C-x v w A +@findex vc-apply-root-to-other-working-tree +The command @kbd{C-x v w A} works similarly, except that it always +copies or moves all local changes to the whole working tree, not just +changes to the current VC fileset or changes represented by the contents +of a Diff mode buffer. With two prefix arguments, this command shows a +preview of changes to be copied, leaving you to apply them using +standard Diff mode commands like @kbd{C-c C-a} and @w{@kbd{C-c a}} +(@pxref{Diff Mode}). (@w{@kbd{C-u C-u C-x v w A}} is roughly equivalent +to typing @w{@kbd{C-x v D}} followed by @w{@kbd{C-x v w w}}.) + @kindex C-x v w x @kindex C-x v w R @findex vc-delete-working-tree diff --git a/etc/NEWS b/etc/NEWS index 27e3f1e4ce0..736874c1a0a 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2072,6 +2072,8 @@ other working trees: - 'C-x v w c': Add a new working tree. - 'C-x v w w': Visit this file in another working tree. - 'C-x v w s': Like 'C-x p p' but limited to other working trees. +- 'C-x v w a': Copy or move fileset changes to another working tree. +- 'C-x v w A': Copy or move all changes to another working tree. - 'C-x v w x': Delete a working tree you no longer need. - 'C-x v w R': Relocate a working tree to another file name. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index c58ad67ff52..f207f87811c 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -2213,17 +2213,21 @@ customize `diff-ask-before-revert-and-kill-hunk' to control that." (when (null (diff-apply-buffer beg end t)) (diff-hunk-kill))))) -(defun diff-apply-buffer (&optional beg end reverse) +(defun diff-apply-buffer (&optional beg end reverse test) "Apply the diff in the entire diff buffer. Interactively, if the region is active, apply all hunks that the region overlaps; otherwise, apply all hunks. With a prefix argument, reverse-apply the hunks. If applying all hunks succeeds, save the changed buffers. -When called from Lisp with optional arguments, restrict the application -to hunks lying between BEG and END, and reverse-apply them when REVERSE -is non-nil. Returns nil if buffers were successfully modified and -saved, or the number of failed hunk applications otherwise." +When called from Lisp, returns nil if buffers were successfully modified +and saved, or the number of failed hunk applications otherwise. +Optional arguments BEG and END restrict the hunks to be applied to those +lying between BEG and END. +Optional argument REVERSE means to reverse-apply hunks. +Optional argument TEST means to not actually apply or reverse-apply any +hunks, but return the same information: nil if all hunks can be applied, +or the number of hunks that can't be applied." (interactive (list (use-region-beginning) (use-region-end) current-prefix-arg)) @@ -2234,7 +2238,7 @@ saved, or the number of failed hunk applications otherwise." (goto-char (or beg (point-min))) (diff-beginning-of-hunk t) (while (pcase-let ((`(,buf ,line-offset ,pos ,_src ,dst ,switched) - (diff-find-source-location nil reverse))) + (diff-find-source-location nil reverse test))) (cond ((and line-offset (not switched)) (push (cons pos dst) (alist-get buf buffer-edits))) @@ -2244,23 +2248,25 @@ saved, or the number of failed hunk applications otherwise." (or (not end) (< (point) end)) (looking-at-p diff-hunk-header-re))))) (cond ((zerop failures) - (dolist (buf-edits (reverse buffer-edits)) - (with-current-buffer (car buf-edits) - (dolist (edit (cdr buf-edits)) - (let ((pos (car edit)) - (dst (cdr edit)) - (inhibit-read-only t)) - (goto-char (car pos)) - (delete-region (car pos) (cdr pos)) - (insert (car dst)))) - (save-buffer))) - (message "Saved %d buffers" (length buffer-edits)) + (unless test + (dolist (buf-edits (reverse buffer-edits)) + (with-current-buffer (car buf-edits) + (dolist (edit (cdr buf-edits)) + (let ((pos (car edit)) + (dst (cdr edit)) + (inhibit-read-only t)) + (goto-char (car pos)) + (delete-region (car pos) (cdr pos)) + (insert (car dst)))) + (save-buffer))) + (message "Saved %d buffers" (length buffer-edits))) nil) (t - (message (ngettext "%d hunk failed; no buffers changed" - "%d hunks failed; no buffers changed" - failures) - failures) + (unless test + (message (ngettext "%d hunk failed; no buffers changed" + "%d hunks failed; no buffers changed" + failures) + failures)) failures)))) (defalias 'diff-mouse-goto-source #'diff-goto-source) @@ -2616,7 +2622,7 @@ Call FUN with two args (BEG and END) for each hunk." (or (ignore-errors (diff-hunk-next) (point)) max))))))))) -;; This doesn't use `diff--iterate-hunks', since that assumes that +;; This doesn't use `diff--iterate-hunks' because that assumes that ;; hunks don't change size. (defun diff--ignore-whitespace-all-hunks () "Re-diff all the hunks, ignoring whitespace-differences." diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el index ded24ada8a0..da67f7f1815 100644 --- a/lisp/vc/vc-hooks.el +++ b/lisp/vc/vc-hooks.el @@ -970,7 +970,9 @@ In the latter case, VC mode is deactivated for this buffer." "w w" #'vc-switch-working-tree "w s" #'vc-working-tree-switch-project "w x" #'vc-delete-working-tree - "w R" #'vc-move-working-tree) + "w R" #'vc-move-working-tree + "w a" #'vc-apply-to-other-working-tree + "w A" #'vc-apply-root-to-other-working-tree) (fset 'vc-prefix-map vc-prefix-map) (define-key ctl-x-map "v" 'vc-prefix-map) diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index e0e9d0e2ac6..07b9ea8b951 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -4661,6 +4661,157 @@ BACKEND is the VC backend." (when-let* ((p (project-current nil to))) (project-remember-project p))) +(declare-function diff-apply-buffer "diff-mode") + +;;;###autoload +(defun vc-apply-to-other-working-tree (directory &optional move) + "Apply VC fileset's local changes to working tree under DIRECTORY. +Must be called from within an existing VC working tree. +When called interactively, prompts for DIRECTORY. +With a prefix argument (when called from Lisp, with optional argument +MOVE non-nil), don't just copy the changes, but move them, from the +current working tree to DIRECTORY. + +When called from a `diff-mode' buffer, move or copy the changes +specified by the contents of that buffer, only. + +If any changes to be moved or copied can't be applied to DIRECTORY, it +is an error, and no changes are applied. +If any changes to be moved can't be reverse-applied to this working +tree, it is an error, and no changes are moved." + ;; The double prefix arg that `vc-apply-root-to-other-working-tree' + ;; has is omitted here, for now, because it is probably less useful. + (interactive + (list + (vc--prompt-other-working-tree + (vc-responsible-backend default-directory) + (format "%s changes to working tree" + (if current-prefix-arg "Move" "Apply"))) + current-prefix-arg)) + (let* ((relative-dir (file-relative-name default-directory + (vc-root-dir))) + (mirror-dir (expand-file-name relative-dir directory))) + (unless (file-directory-p mirror-dir) + (user-error "`%s' not found in `%s'" relative-dir directory)) + (vc--apply-to-other-working-tree directory mirror-dir + (vc-deduce-fileset) + (and (derived-mode-p 'diff-mode) + (buffer-string)) + move))) + +;;;###autoload +(defun vc-apply-root-to-other-working-tree (directory &optional move preview) + "Apply all local changes to this working tree to the one under DIRECTORY. +Must be called from within an existing VC working tree. +When called interactively, prompts for DIRECTORY. +With a prefix argument (when called from Lisp, with optional argument +MOVE non-nil), don't just copy the changes, but move them, from the +current working tree to DIRECTORY. + +With a double prefix argument (\\[universal-argument] \\[universal-argument]; \ +when called from Lisp, with +optional argument PREVIEW non-nil), don't actually apply changes to +DIRECTORY, but instead show all those changes in a `diff-mode' buffer +with `default-directory' set to DIRECTORY. +You can then selectively apply changes with `diff-mode' commands like +`diff-apply-hunk' and `diff-apply-buffer'. + +If any changes to be moved or copied can't be applied to DIRECTORY, it +is an error, and (except with \\[universal-argument] \\[universal-argument]) \ +no changes are applied. +If any changes to be moved can't be reverse-applied to this working +tree, it is an error, and no changes are moved." + (interactive + (list + (vc--prompt-other-working-tree + (vc-responsible-backend default-directory) + (format "%s changes to working tree" + (if (equal current-prefix-arg '(4)) "Move" "Apply"))) + (equal current-prefix-arg '(4)) + (equal current-prefix-arg '(16)))) + (cond ((and move preview) + (error "Invalid arguments to vc-apply-root-to-other-working-tree")) + (preview + ;; In this mode, no need to abort if some hunks aren't + ;; applicable. + (vc-root-diff nil t) + (setq default-directory directory) + (message + (substitute-command-keys + "Use \\[diff-hunk-kill] to kill hunks not to be copied \ +then \\[diff-apply-buffer] to copy changes, +or use \\[diff-apply-hunk] to copy individual hunks. \ +Type \\[describe-mode] for more commands"))) + (t + (let ((default-directory (vc-root-dir))) + (vc--apply-to-other-working-tree directory directory + `(,(vc-deduce-backend) + (,default-directory)) + nil move))))) + +(defcustom vc-no-confirm-moving-changes nil + "Whether VC commands prompt before moving changes between working trees. + +Normally the commands \\[vc-apply-to-other-working-tree] \ +and \\[vc-apply-root-to-other-working-tree] prompt for confirmation +when asked to move changes between working trees (i.e., when invoked +with a prefix argument). This is because it can be surprising to have +work disappear from your current working tree. You can customize this +option to non-nil to skip the prompting." + :type '(choice (const :tag "Prompt before moving changes" nil) + (const :tag "Move changes without prompting" t)) + :group 'vc + :version "31.1") + +(defun vc--apply-to-other-working-tree + (directory mirror-dir fileset patch-string move) + "Workhorse routine for copying/moving changes to other working trees. +DIRECTORY is the root of the target working tree +(used only for messages). +MIRROR-DIR is the target directory for application. +FILESET is the VC fileset from which to copy changes. +PATCH-STRING non-nil overrides calling `vc-diff-internal' on FILESET to +determine the changes to copy or move. +MOVE non-nil means to move instead of copy." + (unless (or (not move) + vc-no-confirm-moving-changes + (yes-or-no-p + (format "Really %s uncommitted work out of this working tree?" + (propertize "move" 'face 'bold)))) + (user-error "Aborted")) + (vc-buffer-sync-fileset fileset nil) + (with-temp-buffer + (if (not patch-string) + (let ((display-buffer-overriding-action '(display-buffer-no-window + (allow-no-window . t)))) + (vc-diff-internal nil fileset nil nil nil (current-buffer))) + (diff-mode) + (insert patch-string)) + (let ((default-directory mirror-dir)) + (vc-buffer-sync-fileset (diff-vc-deduce-fileset) nil)) + (when-let* (move + (failed (diff-apply-buffer nil nil 'reverse 'test))) + ;; If PATCH-STRING is non-nil and this fails, the user called us + ;; from a `diff-mode' buffer that doesn't reverse-apply; that's + ;; a `user-error'. + ;; If PATCH-STRING is nil and this fails, `vc-diff-internal' + ;; generated a nonsense diff -- not the user's fault. + (funcall (if patch-string #'user-error #'error) + (ngettext "%d hunk does not reverse-apply to this working tree" + "%d hunks do not reverse-apply to this working tree" + failed) + failed)) + (let ((default-directory mirror-dir)) + (when-let* ((failed (diff-apply-buffer))) + (user-error (ngettext "%d hunk does not apply to `%s'" + "%d hunks do not apply to `%s'" + failed) + failed directory))) + (when move + (diff-apply-buffer nil nil 'reverse)) + (message "Changes %s to `%s'" + (if move "moved" "applied") directory))) + ;; These things should probably be generally available -- cgit v1.2.1