VC: New commands for cherry-picking (bug#79408)

* lisp/vc/diff-mode.el (diff-buffer-file-names): New function.
* lisp/vc/log-view.el (vc--pick-or-revert)
(vc--prompt-other-working-tree): Autoload.
(vc-parent-buffer-name, vc-log-short-style)
(vc-print-log-internal): Declare.
(log-view--pick-or-revert): New function.
(log-view-revision-cherry-pick, log-view-revision-revert): New
commands.
(log-view-mode-map, log-view-mode-menu): Bind them.
* lisp/vc/vc-dispatcher.el (vc-start-logentry): If
get-file-buffer returns nil, use the current buffer as the
parent buffer.
* lisp/vc/vc.el (diff-buffer-file-names, diff-reverse-direction):
Declare.
(vc--pick-or-revert): New function.
(vc-revision-cherry-pick, vc-revision-revert): New commands.
* lisp/vc/vc-hooks.el (vc-menu-map): Bind them.
* doc/emacs/maintaining.texi (VC Change Log, VC Undo)
(Copying Between Branches):
* etc/NEWS: Document the new commands.

8 files changed, 361 insertions, 27 deletions

diff --git a/doc/emacs/emacs.texi b/doc/emacs/emacs.texi
index b32c704bd12..7a5107ee359 100644
--- a/doc/emacs/emacs.texi
+++ b/doc/emacs/emacs.texi
@@ -857,10 +857,11 @@ VC Directory Mode
 
 Version Control Branches
 
-* Switching Branches::    How to get to another existing branch.
-* Pulling / Pushing::     Receiving/sending changes from/to elsewhere.
-* Merging::               Transferring changes between branches.
-* Creating Branches::     How to start a new branch.
+* Switching Branches::       How to get to another existing branch.
+* Pulling / Pushing::        Receiving/sending changes from/to elsewhere.
+* Merging::                  Transferring changes between branches.
+* Creating Branches::        How to start a new branch.
+* Copying Between Branches:: Copying the changes made by revisions.
 
 @ifnottex
 Miscellaneous Commands and Features of VC
diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi
index e7a05a3556b..9d768cc1a77 100644
--- a/doc/emacs/maintaining.texi
+++ b/doc/emacs/maintaining.texi
@@ -1264,6 +1264,15 @@ Unmark the entry at point (@code{log-view-unmark-entry}).
 
 @item U
 Unmark all marked entries (@code{log-view-unmark-all-entries}).
+
+@item C
+Copy changes to a currently checked out branch; either the changes from
+the revision at point, or the changes from all marked revisions
+(@code{log-view-revision-cherry-pick}).
+
+@item R
+Undo the effects of old revisions; either the revision at point, or all
+marked revisions (@code{log-view-revision-revert}).
 @end table
 
 @vindex vc-log-show-limit
@@ -1307,6 +1316,9 @@ also prompt for a specific VCS shell command to run for this purpose.
 @item C-x v u
 Revert the work file(s) in the current VC fileset to the last revision
 (@code{vc-revert}).
+
+@item M-x vc-revision-revert
+Undo the effects of an older commit.
 @end table
 
 @kindex C-x v u
@@ -1330,6 +1342,21 @@ unlocked; you must lock again to resume editing.  You can also use
 @kbd{C-x v u} to unlock a file if you lock it and then decide not to
 change it.
 
+@findex vc-revision-revert
+@cindex reverting commits
+  To discard changes that have already been committed, by yourself or
+someone else, you can use @w{@kbd{M-x vc-revision-revert}}.  This is
+called @dfn{reverting} a commit.  The command prompts for a revision to
+revert, and then the VC backend reverts it.  Most backends implement
+this by making a new commit which undoes the changes made by the
+revision.
+
+  An alternative way to access this functionality is to the
+@code{log-view-revision-revert} command, bound to @kbd{R} in Log View
+mode buffers (@pxref{VC Change Log}).  Compared to using @w{@kbd{M-x
+vc-revision revert}} directly, this can make it easier to be sure you
+are reverting the revision you intend.
+
 @node VC Ignore
 @subsection Ignore Version Control Files
 
@@ -1642,10 +1669,11 @@ supports checking out different branches and committing into new or
 different branches.
 
 @menu
-* Switching Branches::    How to get to another existing branch.
-* Pulling / Pushing::     Receiving/sending changes from/to elsewhere.
-* Merging::               Transferring changes between branches.
-* Creating Branches::     How to start a new branch.
+* Switching Branches::       How to get to another existing branch.
+* Pulling / Pushing::        Receiving/sending changes from/to elsewhere.
+* Merging::                  Transferring changes between branches.
+* Creating Branches::        How to start a new branch.
+* Copying Between Branches:: Copying the changes made by revisions.
 @end menu
 
 @node Switching Branches
@@ -1857,6 +1885,51 @@ revision.
 on that branch.  To leave the branch, you must explicitly select a
 different revision with @kbd{C-u C-x v v}.
 
+@node Copying Between Branches
+@subsubsection Copying Changes Made By Revisions Between Branches
+
+@table @kbd
+@item M-x vc-revision-cherry-pick
+Copy a single revision to branch checked out in this working tree.
+@end table
+
+@cindex cherry-pick
+@cindex revision, cherry-picks of
+  Sometimes it is useful to copy a revision from one branch to another.
+This means creating a new revision with the same changes, log message
+and authorship information as an existing revision that can be found on
+another branch.  This is often called @dfn{cherry-picking} the revision
+from one branch to another.
+
+@cindex revisions, backporting
+  The most common case is copying a revision from a branch that won't be
+merged (@pxref{Merging}) into your current branch.  For example, your
+project might have a feature-frozen branch that accepts only bug fixes.
+Someone (possibly you) fixes a bug on the main development branch.  You
+can then cherry-pick that revision onto the feature-frozen branch in
+order to fix the bug there, too.  This is called @dfn{backporting} the
+revision, or backporting the fix.
+
+@findex vc-revision-cherry-pick
+  You can use the command @kbd{M-x vc-revision-cherry-pick} to
+cherry-pick revisions.  It prompts for a revision to cherry-pick.  It
+then pops up a buffer for you to edit the log message for the new
+revision.  Normally the VC backend generates a log message including a
+reference to the revision you want to copy, so that the copy can be
+traced.  If you wish, you can delete this reference before typing
+@kbd{C-c C-c} to conclude the cherry-pick.
+
+  Alternatively you can invoke the command with a prefix argument,
+i.e. @w{@kbd{C-u M-x vc-revision-cherry-pick}}.  In this case the log
+message from the source revision is used unmodified, and the cherry-pick
+happens immediately, without popping up a buffer for log message edits.
+
+  An alternative way to access this functionality is the
+@code{log-view-revision-cherry-pick} command, bound to @kbd{C} in Log
+View mode buffers (@pxref{VC Change Log}).  Compared to using
+@w{@kbd{M-x vc-revision-cherry-pick}} directly, this can make it easier
+to be sure you are cherry-picking the revision you intend.
+
 @ifnottex
 @include vc1-xtra.texi
 @end ifnottex
diff --git a/etc/NEWS b/etc/NEWS
index 8cabafd57cf..09497e499ab 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -2227,6 +2227,14 @@ after VCS operations, the new mode is a more reliable way to ensure that
 Emacs reverts buffers visiting tracked files when VCS operations change
 the contents of those files.
 
++++
+*** New commands to cherry-pick and revert revisions.
+The commands 'vc-revision-cherry-pick' and 'vc-revision-revert' let you
+copy revisions between branches, and revert revisions.
+From Log View buffers, you can use 'C' to cherry-pick the revision at
+point or all marked revisions, and 'R' to revert the revision at point
+or all marked revisions.
+
 *** New command 'log-edit-done-strip-cvs-lines'.
 This command strips all lines beginning with "CVS:" from the buffer.
 It is intended to be added to the 'log-edit-done-hook' so that
diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el
index f207f87811c..2fb552597fd 100644
--- a/lisp/vc/diff-mode.el
+++ b/lisp/vc/diff-mode.el
@@ -1175,6 +1175,21 @@ PREFIX is only used internally: don't use it."
                            (cons (cons fs file) diff-remembered-files-alist)))
              file)))))))
 
+(defun diff-buffer-file-names (&optional old noprompt)
+  "Return file names corresponding to all of this buffer's hunks.
+Optional arguments OLD and NOPROMPT are passed on to
+`diff-find-file-name', which see."
+  (save-excursion
+    (cl-loop initially
+             (goto-char (point-min))
+             (ignore-errors (diff-file-next))
+             when (and (looking-at diff-file-header-re)
+                       (diff-find-file-name old noprompt))
+             collect it
+             until (eq (prog1 (point)
+                         (ignore-errors (diff-file-next)))
+                       (point)))))
+
 
 (defun diff-ediff-patch ()
   "Call `ediff-patch-file' on the current buffer."
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 68ce4f1baa5..0e2d506a23a 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -114,6 +114,8 @@
 (require 'log-edit)
 (autoload 'vc-find-revision "vc")
 (autoload 'vc-diff-internal "vc")
+(autoload 'vc--pick-or-revert "vc")
+(autoload 'vc--prompt-other-working-tree "vc")
 
 (defvar cvs-minor-wrap-function)
 (defvar cvs-force-command)
@@ -138,7 +140,9 @@
   "p" #'log-view-msg-prev
   "w" #'log-view-copy-revision-as-kill
   "TAB" #'log-view-msg-next
-  "<backtab>" #'log-view-msg-prev)
+  "<backtab>" #'log-view-msg-prev
+  "C" #'log-view-revision-cherry-pick
+  "R" #'log-view-revision-revert)
 
 (easy-menu-define log-view-mode-menu log-view-mode-map
   "Log-View Display Menu."
@@ -161,6 +165,11 @@
     ["Toggle Details at Point" log-view-toggle-entry-display
      :active log-view-expanded-log-entry-function]
     "-----"
+    ["Cherry-Pick Revision(s)" log-view-revision-cherry-pick
+     :help "Copy changes from revision(s) to a branch"]
+    ["Revert Revision(s)" log-view-revision-revert
+     :help "Undo the effects of old revision(s)"]
+    "-----"
     ["Next Log Entry"  log-view-msg-next
      :help "Go to the next count'th log message"]
     ["Previous Log Entry"  log-view-msg-prev
@@ -686,9 +695,114 @@ If called interactively, annotate the version at point."
                  (log-view-current-tag)
                  nil nil nil log-view-vc-backend)))
 
-;;
-;; diff
-;;
+;;;;
+;;;; Cherry-picks and reverts
+;;;;
+
+(defvar vc-parent-buffer-name)
+(defvar vc-log-short-style)
+(declare-function vc-print-log-internal "vc")
+
+(defun log-view--pick-or-revert (directory no-comment reverse)
+  "Copy changes from revision at point or all marked revisions.
+DIRECTORY is the destination, the root of the target working tree.
+NO-COMMENT non-nil means use the log messages of the revisions
+unmodified, instead of using the backend's default cherry-pick comment
+for that revision.
+NO-COMMENT non-nil with zero or one revisions marked also means don't
+prompt to edit the log message.
+REVERSE non-nil means to make commit(s) undoing the effects of the
+revisions, instead."
+  (let ((default-directory directory)
+        (marked (log-view-get-marked)))
+    (if (length> marked 1)
+        (progn
+          (save-excursion
+            (dolist (rev (if reverse (reverse marked) marked))
+              ;; Unmark each revision *before* copying it.
+              ;; Then if there is a conflict such that a cherry-pick
+              ;; fails, after resolving that conflict and committing the
+              ;; cherry-pick, the right revisions will be marked to
+              ;; resume the original multiple cherry-pick operation.
+              (log-view-goto-rev rev)
+              (log-view-unmark-entry 1)
+              (vc--pick-or-revert rev
+                                  reverse
+                                  (if no-comment
+                                      (vc-call-backend log-view-vc-backend
+                                                       'get-change-comment
+                                                       nil rev)
+                                    t)
+                                  nil
+                                  log-view-vc-backend)))
+          (when (vc-find-backend-function log-view-vc-backend
+                                          'modify-change-comment)
+            (let (vc-log-short-style)
+              (vc-print-log-internal log-view-vc-backend
+                                     (list default-directory)
+                                     nil nil (length marked)))
+            (setq-local vc-log-short-style nil ; For \\`g'.
+                        vc-parent-buffer-name nil)
+            (message (substitute-command-keys "Use \
+\\[log-view-modify-change-comment] to modify any of these messages"))))
+      (let ((rev (or (car marked) (log-view-current-tag))))
+        (vc--pick-or-revert rev
+                            reverse
+                            (and no-comment
+                                 (vc-call-backend log-view-vc-backend
+                                                  'get-change-comment
+                                                  nil rev))
+                            nil
+                            log-view-vc-backend)))))
+
+(defun log-view-revision-cherry-pick (directory &optional no-comment)
+  "Copy changes from revision at point to current branch.
+If there are marked revisions, use those instead of the revision at point.
+
+When called interactively, prompts for the target working tree to which
+to copy the revision(s); the current working tree is the default choice.
+When called from Lisp, DIRECTORY is the root of the target working tree.
+
+When copying a single revision, prompts for editing the log message for
+the new commit, except with optional argument NO-COMMENT non-nil
+(interactively, with a prefix argument).
+When copying multiple revisions, never prompts to edit log messages.
+
+Normally a log message for each new commit is generated by the backend,
+including references to the source commits so that the copy can be
+traced.  With optional argument NO-COMMENT non-nil (interactively, with
+a prefix argument), use the log messages from the source revisions
+unmodified.
+
+See also `vc-revision-cherry-pick'."
+  (interactive
+   (list (vc--prompt-other-working-tree log-view-vc-backend
+                                        "Cherry-pick to working tree"
+                                        'allow-empty)
+         current-prefix-arg))
+  (log-view--pick-or-revert directory no-comment nil))
+
+(defun log-view-revision-revert (directory)
+  "Undo the effects of the revision at point.
+When revisions are marked, undo the effects of each of them.
+When called interactively, prompts for the target working tree in which
+to revert; the current working tree is the default choice.
+When called from Lisp, DIRECTORY is the root of the target working tree.
+
+When reverting a single revision, prompts for editing the log message
+for the new commit.
+When reverting multiple revisions, never prompts to edit log messages.
+
+See also `vc-revision-revert'."
+  (interactive (list (vc--prompt-other-working-tree
+                      (vc-responsible-backend default-directory)
+                      "Revert in working tree"
+                      'allow-empty)))
+  (log-view--pick-or-revert directory nil t))
+
+;;;;
+;;;; diff
+;;;;
 
 (defun log-view-diff (beg end)
   "Get the diff between two revisions.
diff --git a/lisp/vc/vc-dispatcher.el b/lisp/vc/vc-dispatcher.el
index c4ad148bdf1..78173786705 100644
--- a/lisp/vc/vc-dispatcher.el
+++ b/lisp/vc/vc-dispatcher.el
@@ -836,12 +836,10 @@ AFTER-HOOK specifies the local value for `vc-log-after-operation-hook'.
 BACKEND, if non-nil, specifies a VC backend for the Log Edit buffer.
 PATCH-STRING is a patch to check in.
 DIFF-FUNCTION is `log-edit-diff-function' for the Log Edit buffer."
-  (let ((parent (if (and (length= files 1)
-                         (not (vc-dispatcher-browsing)))
-                    (get-file-buffer (car files))
-                  (current-buffer))))
-    (unless parent
-      (error "Unable to determine VC parent buffer"))
+  (let ((parent (or (and (length= files 1)
+                         (not (vc-dispatcher-browsing))
+                         (get-file-buffer (car files)))
+                    (current-buffer))))
     (if (and comment (not initial-contents))
         (set-buffer (get-buffer-create logbuf))
       (pop-to-buffer (get-buffer-create logbuf)))
diff --git a/lisp/vc/vc-hooks.el b/lisp/vc/vc-hooks.el
index 2972f139d06..48e84d6aee1 100644
--- a/lisp/vc/vc-hooks.el
+++ b/lisp/vc/vc-hooks.el
@@ -1010,11 +1010,16 @@ other commands receive global bindings where they had none before."
 
 (defvar vc-menu-map
   (let ((map (make-sparse-keymap "Version Control")))
-    ;;(define-key map [show-files]
-    ;;  '("Show Files under VC" . (vc-directory t)))
+    (define-key map [vc-revision-revert]
+                '(menu-item "Revert Revision" vc-revision-revert
+                            :help "Undo the effects of a revision"))
+    (define-key map [vc-revision-cherry-pick]
+                '(menu-item "Cherry-Pick Revision" vc-revision-cherry-pick
+                            :help "Copy the changes from a single revision to this branch"))
+    (define-key map [separator1] menu-bar-separator)
     (define-key map [vc-retrieve-tag]
-      '(menu-item "Retrieve Tag" vc-retrieve-tag
-                  :help "Retrieve tagged version or branch"))
+                '(menu-item "Retrieve Tag" vc-retrieve-tag
+                            :help "Retrieve tagged version or branch"))
     (define-key map [vc-create-tag]
       '(menu-item "Create Tag" vc-create-tag
                   :help "Create version tag"))
@@ -1027,7 +1032,7 @@ other commands receive global bindings where they had none before."
     (define-key map [vc-create-branch]
       '(menu-item "Create Branch..." vc-create-branch
                   :help "Make a new branch"))
-    (define-key map [separator1] menu-bar-separator)
+    (define-key map [separator2] menu-bar-separator)
     (define-key map [vc-annotate]
       '(menu-item "Annotate" vc-annotate
                   :help "Display the edit history of the current file using colors"))
@@ -1058,7 +1063,7 @@ other commands receive global bindings where they had none before."
     (define-key map [vc-print-root-log]
       '(menu-item "Show Top of the Tree History " vc-print-root-log
                   :help "List the change log for the current tree in a window"))
-    (define-key map [separator2] menu-bar-separator)
+    (define-key map [separator3] menu-bar-separator)
     (define-key map [vc-insert-header]
       '(menu-item "Insert Header" vc-insert-headers
                   :help "Insert headers into a file for use with a version control system."))
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 55606f29bea..7c28e4092dd 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -2006,9 +2006,15 @@ Type \\[vc-next-action] to check in changes.")
     (files backend &optional comment initial-contents rev patch-string register)
   "Check in FILES.
 
-COMMENT is a comment string; if omitted, a buffer is popped up to accept
-a comment.  If INITIAL-CONTENTS is non-nil, then COMMENT is used as the
-initial contents of the log entry buffer.
+There are three calling conventions for the COMMENT and INITIAL-CONTENTS
+optional arguments:
+- COMMENT a string, INITIAL-CONTENTS nil means use that comment string
+  without prompting the user to edit it.
+- COMMENT a string, INITIAL-CONTENTS non-nil means use that comment
+  string as the initial contents of the log entry buffer but stop for
+  editing.
+- COMMENT t means check in immediately with an empty comment, and ignore
+  INITIAL-CONTENTS.
 
 The optional argument REV may be a string specifying the new revision
 level (only supported for some older VCSes, like RCS and CVS).
@@ -2105,6 +2111,120 @@ have changed; continue with old fileset?" (current-buffer))))
     backend
     patch-string)))
 
+(declare-function diff-buffer-file-names "diff-mode")
+(declare-function diff-reverse-direction "diff-mode")
+
+(defun vc--pick-or-revert (rev reverse comment initial-contents backend)
+  "Copy a single revision REV to branch checked out in this working tree.
+REVERSE means to undo the effects of REV, instead.
+COMMENT is a comment string; if omitted, a buffer is popped up to accept
+a comment.  If INITIAL-CONTENTS is non-nil, then COMMENT is used as the
+initial contents of the log entry buffer.  If COMMENT is t then use
+BACKEND's default cherry-pick comment for REV without prompting.
+BACKEND is the VC backend to use."
+  (let* ((backend (or backend (vc-responsible-backend default-directory)))
+         ;; `vc-*-prepare-patch' will always give us a patch with file
+         ;; names relative to the VC root, so switch to there now.
+         ;; In particular this is needed for `diff-buffer-file-names' to
+         ;; work properly.
+         (default-directory (vc-call-backend backend 'root default-directory))
+         (patch (vc-call-backend backend 'prepare-patch rev))
+         files whole-patch-string diff-patch-string)
+    (with-current-buffer (plist-get patch :buffer)
+      (diff-mode)
+      (with-restriction
+          (or (plist-get patch :patch-start) (point-min))
+          (or (plist-get patch :patch-end) (point-max))
+        (when reverse
+          (diff-reverse-direction (point-min) (point-max)))
+        (setq files (diff-buffer-file-names nil t)
+              diff-patch-string (buffer-string)))
+      ;; In the case of reverting we mustn't copy the original
+      ;; authorship information.  The author of the revert is the
+      ;; current user, and its timestamp is now.
+      (setq whole-patch-string
+            (if reverse diff-patch-string (buffer-string))))
+    (unless (stringp comment)
+      (cl-psetq comment (vc-call-backend backend 'cherry-pick-comment
+                                         files rev reverse)
+                initial-contents (not (eq comment t))))
+    (vc-start-logentry files comment initial-contents
+                       (format "Edit log message for %s revision."
+                               (if reverse
+                                   "new"
+                                 ;; ^ "reverted revision" would mean
+                                 ;;   REV, not the revision we are about
+                                 ;;   to create.  We could use
+                                 ;;   "reverting revision" but it reads
+                                 ;;   oddly.
+                                 "copied"))
+                       "*vc-cherry-pick*"
+                       (lambda ()
+                         (vc-call-backend backend 'log-edit-mode))
+                       (lambda (_files comment)
+                         (vc-call-backend backend 'checkin-patch
+                                          whole-patch-string comment))
+                       nil
+                       backend
+                       diff-patch-string)))
+
+;; No bindings in `vc-prefix-map' for the following two commands because
+;; we expect users will usually use `log-view-revision-cherry-pick' and
+;; `log-view-revision-revert', which do have bindings.
+
+;;;###autoload
+(defun vc-revision-cherry-pick (rev &optional comment initial-contents backend)
+  "Copy the changes from a single revision REV to the current branch.
+When called interactively, prompts for REV.
+Typically REV is a revision from another branch, where that branch is
+one that will not be merged into the branch checked out in this working
+tree.
+
+Normally a log message for the new commit is generated by the backend
+and includes a reference to REV so that the copy can be traced.
+When called interactively with a prefix argument, use REV's log message
+unmodified, and also skip editing it.
+
+When called from Lisp, there are three calling conventions for the
+COMMENT and INITIAL-CONTENTS optional arguments:
+- COMMENT a string, INITIAL-CONTENTS nil means use that comment string
+  without prompting the user to edit it.
+- COMMENT a string, INITIAL-CONTENTS non-nil means use that comment
+  string as the initial contents of the log entry buffer but stop for
+  editing.
+- COMMENT t means use BACKEND's default cherry-pick comment for REV
+  without prompting for editing, and ignore INITIAL-CONTENTS.
+
+Optional argument BACKEND is the VC backend to use."
+  (interactive (let ((rev (vc-read-revision "Revision to copy: "))
+                     (backend (vc-responsible-backend default-directory)))
+                 (list rev
+                       (and current-prefix-arg
+                            (vc-call-backend backend 'get-change-comment
+                                             nil rev))
+                       nil
+                       backend)))
+  (vc--pick-or-revert rev nil comment initial-contents backend))
+
+;;;###autoload
+(defun vc-revision-revert (rev &optional comment initial-contents backend)
+  "Undo the effects of revision REV.
+When called interactively, prompts for REV.
+
+When called from Lisp, there are three calling conventions for the
+COMMENT and INITIAL-CONTENTS optional arguments:
+- COMMENT a string, INITIAL-CONTENTS nil means use that comment string
+  without prompting the user to edit it.
+- COMMENT a string, INITIAL-CONTENTS non-nil means use that comment
+  string as the initial contents of the log entry buffer but stop for
+  editing.
+- COMMENT t means use BACKEND's default revert comment for REV without
+  prompting for editing, and ignore INITIAL-CONTENTS.
+
+Optional argument BACKEND is the VC backend to use."
+  (interactive (list (vc-read-revision "Revision to revert: ")))
+  (vc--pick-or-revert rev t comment initial-contents backend))
+
 (declare-function diff-bounds-of-hunk "diff-mode")
 
 (defun vc-default-checkin-patch (_backend patch-string comment)