mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

New commands to apply changes to other working trees

Browse source 
* 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.
This commit is contained in:
Sean Whitton 2025-09-04 11:25:25 +01:00
parent 0000d9b7b1
commit 208e80018a
5 changed files with 227 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

52
doc/emacs/vc1-xtra.texi
View file

@ -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 <RET> 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

2
etc/NEWS
View file

@ -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.

24
lisp/vc/diff-mode.el
View file

@ -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,6 +2248,7 @@ saved, or the number of failed hunk applications otherwise."
(or (not end) (< (point) end))
(looking-at-p diff-hunk-header-re)))))
(cond ((zerop failures)
(unless test
(dolist (buf-edits (reverse buffer-edits))
(with-current-buffer (car buf-edits)
(dolist (edit (cdr buf-edits))
@ -2254,13 +2259,14 @@ saved, or the number of failed hunk applications otherwise."
(delete-region (car pos) (cdr pos))
(insert (car dst))))
(save-buffer)))
(message "Saved %d buffers" (length buffer-edits))
(message "Saved %d buffers" (length buffer-edits)))
nil)
(t
(unless test
(message (ngettext "%d hunk failed; no buffers changed"
"%d hunks failed; no buffers changed"
failures)
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."

4
lisp/vc/vc-hooks.el
View file

@ -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)

151
lisp/vc/vc.el
View file

@ -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