bug#57400: 29.0.50; Support sending patches from VC directly

[Philip Kaludercic <philipk@posteo.net>]

[-- Attachment #1: Type: text/plain, Size: 43 bytes --]


Here is an updated version of the patch:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-a-VC-command-to-prepare-patches.patch --]
[-- Type: text/x-patch, Size: 14762 bytes --]

From a384a0b74e8037c642ac49dbad9489fd51f6c8cd Mon Sep 17 00:00:00 2001
From: Philip Kaludercic <philipk@posteo.net>
Date: Mon, 3 Oct 2022 20:54:38 +0200
Subject: [PATCH] Add a VC command to prepare patches

* doc/emacs/vc1-xtra.texi (Miscellaneous VC):  Add new node.
(Editing VC Commands):  Document new feature.
* etc/NEWS:  Mention 'vc-prepare-patch'.
* lisp/vc/log-view.el: Autoload 'log-view-get-marked'.
* lisp/vc/vc-git.el (vc-git-prepare-patch):  Add Git implementation.
* lisp/vc/vc-hg.el (vc-git-prepare-patch):  Add Mercurial implementation.
* lisp/vc/vc-bzr.el (vc-git-prepare-patch):  Add Bazaar implementation.
* lisp/vc/vc.el (vc-read-revision):  Add a MULTIPLE argument.
(vc-read-multiple-revisions):  Add an auxiliary function that always
calls 'vc-read-revision' with a non-nil value for MULTIPLE.
(vc-prepare-patches-inline):  Add user option.
(message-goto-body):  Declare function.
(message--name-table):  Declare function.
(vc-default-prepare-patch): Add a default implementation.
(vc-prepare-patch):  Add command.  (bug#57400)
---
 doc/emacs/vc1-xtra.texi |  26 +++++++++
 etc/NEWS                |  15 +++++
 lisp/vc/log-view.el     |   1 +
 lisp/vc/vc-bzr.el       |  14 +++++
 lisp/vc/vc-git.el       |  24 ++++++++
 lisp/vc/vc-hg.el        |  12 ++++
 lisp/vc/vc.el           | 121 ++++++++++++++++++++++++++++++++++++++--
 7 files changed, 209 insertions(+), 4 deletions(-)

diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 05d2144380..523e4611f0 100644
--- a/doc/emacs/vc1-xtra.texi
+++ b/doc/emacs/vc1-xtra.texi
@@ -16,6 +16,7 @@ Miscellaneous VC
 * Revision Tags::       Symbolic names for revisions.
 * Version Headers::     Inserting version control headers into working files.
 * Editing VC Commands:: Editing the VC shell commands that Emacs will run.
+* Preparing Patches::   Preparing and Composing patches from within VC
 @end menu
 
 @node Change Logs and VC
@@ -282,6 +283,31 @@ Editing VC Commands
 additional branches to the end of the @samp{git log} command that VC
 is about to run.
 
+@node Preparing Patches
+@subsubsection Preparing Patches
+
+@findex vc-prepare-patch
+When collaborating on projects it is common to send patches via Email,
+to share changes.  If you wish to do this using VC, you can use the
+@code{vc-prepare-patch} command.  This will prompt you which revisions
+you wish to share and who the addressee is.  The command will then use
+your @abbr{MUA, Mail User Agent} for you to review and send out.
+
+@vindex vc-prepare-patches-inline
+Depending on configuration of the user option
+@code{vc-prepare-patches-inline}, @code{vc-prepare-patch} will either
+generate a single or multiple messages.  A @code{nil} value (the default)
+will prepare and display a message for each revision, one after
+another.  A non-@code{nil} value will have all patches attached to the
+body of a single message.
+
+@vindex vc-default-patch-addressee
+If you expect to contribute patches on a regular basis, you can set
+the user option @code{vc-default-patch-addressee} to the address you
+wish to use.  This will be used as the default value when invoking
+@code{vc-prepare-patch}.  Project maintainers may consider setting
+this as a directory local variable (@pxref{Directory Variables}).
+
 @node Customizing VC
 @subsection Customizing VC
 
diff --git a/etc/NEWS b/etc/NEWS
index 0fa24c577c..78c607f0e9 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1846,6 +1846,14 @@ Git commands display summary lines.  See the two new user options
 It is used to style the line that separates the 'log-edit' headers
 from the 'log-edit' summary.
 
++++
+*** New 'vc-prepare-patch' command.
+Patches for any version control system can be prepared using VC.  The
+command will query what commits to send and will compose messages for
+your mail user agent.  The behaviour of 'vc-prepare-patch' can be
+modified by the user options 'vc-prepare-patches-inline' and
+'vc-default-patch-addressee'.
+
 ** Message
 
 ---
@@ -2043,6 +2051,13 @@ The new ':doc-spec-function' element can be used to compute the
 ':doc-spec' element when the user asks for info on that particular
 mode (instead of at load time).
 
+** Subr-x
+
+---
+*** New macro 'with-funcall-substitutions'.
+The macro can be used to generically substitute function symbols in
+expressions.
+
 ** Ansi-color
 
 ---
diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el
index 415b1564ed..7a710386fe 100644
--- a/lisp/vc/log-view.el
+++ b/lisp/vc/log-view.el
@@ -359,6 +359,7 @@ log-view-toggle-mark-entry
 	    (overlay-put ov 'log-view-self ov)
 	    (overlay-put ov 'log-view-marked (nth 1 entry))))))))
 
+;;;###autoload
 (defun log-view-get-marked ()
   "Return the list of tags for the marked log entries."
   (save-excursion
diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el
index bce7996712..6f77f99555 100644
--- a/lisp/vc/vc-bzr.el
+++ b/lisp/vc/vc-bzr.el
@@ -1324,6 +1324,20 @@ vc-bzr-repository-url
           (match-string 1)
         (error "Cannot determine Bzr repository URL")))))
 
+(defun vc-bzr-prepare-patch (rev)
+  (with-current-buffer (generate-new-buffer " *vc-bzr-prepare-patch*")
+    (vc-bzr-command
+     "send" t 0 '()
+     "--revision" (concat (vc-bzr-previous-revision nil rev) ".." rev)
+     "--output" "-")
+    (let (subject)
+      ;; Extract the subject line
+      (goto-char (point-min))
+      (search-forward-regexp "^[^#].*")
+      (setq subject (match-string 0))
+      ;; Return the extracted data
+      (list :subject subject :buffer (current-buffer)))))
+
 (provide 'vc-bzr)
 
 ;;; vc-bzr.el ends here
diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el
index 4a2a42ad2a..f9dae8b9ea 100644
--- a/lisp/vc/vc-git.el
+++ b/lisp/vc/vc-git.el
@@ -95,6 +95,7 @@
 ;; - find-file-hook ()                             OK
 ;; - conflicted-files                              OK
 ;; - repository-url (file-or-dir)                  OK
+;; - prepare-patch (rev)                           OK
 
 ;;; Code:
 
@@ -1742,6 +1743,29 @@ vc-git-extra-status-menu
 (defun vc-git-root (file)
   (vc-find-root file ".git"))
 
+(defun vc-git-prepare-patch (rev)
+  (with-current-buffer (generate-new-buffer " *vc-git-prepare-patch*")
+    (vc-git-command
+     t 0 '()  "format-patch"
+     "--no-numbered" "--stdout"
+     ;; From gitrevisions(7): ^<n> means the <n>th parent
+     ;; (i.e.  <rev>^ is equivalent to <rev>^1). As a
+     ;; special rule, <rev>^0 means the commit itself and
+     ;; is used when <rev> is the object name of a tag
+     ;; object that refers to a commit object.
+     (concat rev "^.." rev))
+    (let (subject)
+      ;; Extract the subject line
+      (goto-char (point-min))
+      (search-forward-regexp "^Subject: \\(.+\\)")
+      (setq subject (match-string 1))
+      ;; Jump to the beginning for the patch
+      (search-forward-regexp "\n\n")
+      ;; Return the extracted data
+      (list :subject subject
+            :buffer (current-buffer)
+            :body-start (point)))))
+
 ;; grep-compute-defaults autoloads grep.
 (declare-function grep-read-regexp "grep" ())
 (declare-function grep-read-files "grep" (regexp))
diff --git a/lisp/vc/vc-hg.el b/lisp/vc/vc-hg.el
index eed9592378..2eebe2d543 100644
--- a/lisp/vc/vc-hg.el
+++ b/lisp/vc/vc-hg.el
@@ -80,6 +80,7 @@
 ;; - delete-file (file)                        TEST IT
 ;; - rename-file (old new)                     OK
 ;; - find-file-hook ()                         added for bug#10709
+;; - prepare-patch (rev)                       OK
 
 ;; 2) Implement Stefan Monnier's advice:
 ;; vc-hg-registered and vc-hg-state
@@ -1507,6 +1508,17 @@ vc-hg-merge-branch
     (with-current-buffer buffer (vc-run-delayed (vc-compilation-mode 'hg)))
     (vc-set-async-update buffer)))
 
+(defun vc-hg-prepare-patch (rev)
+  (with-current-buffer (generate-new-buffer " *vc-hg-prepare-patch*")
+    (vc-hg-command t 0 '() "export" "--rev" rev)
+    (let (subject)
+      ;; Extract the subject line
+      (goto-char (point-min))
+      (search-forward-regexp "^[^#].*")
+      (setq subject (match-string 0))
+      ;; Return the extracted data
+      (list :subject subject :buffer (current-buffer)))))
+
 ;;; Internal functions
 
 (defun vc-hg-command (buffer okstatus file-or-list &rest flags)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index f0f5ee504c..f0bd1023ac 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -574,6 +574,14 @@
 ;;   containing FILE-OR-DIR.  The optional REMOTE-NAME specifies the
 ;;   remote (in Git parlance) whose URL is to be returned.  It has
 ;;   only a meaning for distributed VCS and is ignored otherwise.
+;;
+;; - prepare-patch (rev)
+;;
+;;   Prepare a patch and return a property list with the keys
+;;   `:subject' indicating the patch message as a string, `:body'
+;;   containing the contents of the patch as a string (excluding the
+;;   header) and `:filename' pointing to a file where the patch has
+;;   been stored.
 
 ;;; Changes from the pre-25.1 API:
 ;;
@@ -1910,7 +1918,7 @@ vc-diff-internal
 (defvar vc-revision-history nil
   "History for `vc-read-revision'.")
 
-(defun vc-read-revision (prompt &optional files backend default initial-input)
+(defun vc-read-revision (prompt &optional files backend default initial-input multiple)
   (cond
    ((null files)
     (let ((vc-fileset (vc-deduce-fileset t))) ;FIXME: why t?  --Stef
@@ -1923,9 +1931,16 @@ vc-read-revision
          (completion-table
           (vc-call-backend backend 'revision-completion-table files)))
     (if completion-table
-        (completing-read prompt completion-table
-                         nil nil initial-input 'vc-revision-history default)
-      (read-string prompt initial-input nil default))))
+        (funcall
+         (if multiple #'completing-read-multiple #'completing-read)
+         prompt completion-table nil nil initial-input 'vc-revision-history default)
+      (let ((answer (read-string prompt initial-input nil default)))
+        (if multiple
+            (split-string answer "[ \t]*,[ \t]*")
+          answer)))))
+
+(defun vc-read-multiple-revisions (prompt &optional files backend default initial-input)
+  (vc-read-revision prompt files backend default initial-input t))
 
 (defun vc-diff-build-argument-list-internal (&optional fileset)
   "Build argument list for calling internal diff functions."
@@ -3237,6 +3252,104 @@ vc-update-change-log
   (vc-call-backend (vc-responsible-backend default-directory)
                    'update-changelog args))
 
+(defcustom vc-prepare-patches-inline nil
+  "Non-nil means that `vc-prepare-patch' creates a single message.
+A single message is created by attaching all patches to the body
+of a single message.  If nil, each patch will be sent out in a
+separate message, which will be prepared sequentially."
+  :type 'boolean
+  :safe #'booleanp
+  :version "29.1")
+
+(defcustom vc-default-patch-addressee nil
+  "Default addressee for `vc-prepare-patch'.
+If nil, no default will be used.  This option may be set locally."
+  :type '(choice (const :tag "No default" nil) string)
+  :safe #'stringp
+  :version "29.1")
+
+(declare-function message--name-table "message" (orig-string))
+(declare-function mml-attach-buffer "mml"
+                  (buffer &optional type description disposition))
+(declare-function log-view-get-marked "log-view" ())
+
+(defun vc-default-prepare-patch (rev)
+  (let ((backend (vc-backend buffer-file-name)))
+    (with-current-buffer (generate-new-buffer " *vc-default-prepare-patch*")
+      (vc-diff-internal
+       nil (list backend) rev
+       (vc-call-backend backend 'previous-revision
+                        buffer-file-name rev)
+       nil t)
+      (list :subject (concat "Patch for "
+                             (file-name-nondirectory
+                              (directory-file-name
+                               (vc-root-dir))))
+            :buffer (current-buffer)))))
+
+;;;###autoload
+(defun vc-prepare-patch (addressee subject revisions)
+  "Compose an Email sending patches for REVISIONS to ADDRESSEE.
+If `vc-prepare-patches-inline' is non-nil, SUBJECT will be used
+as the default subject for the message.  Otherwise a separate
+message will be composed for each revision.
+
+When invoked interactively in a Log View buffer with marked
+revisions, these revisions will be used."
+  (interactive
+   (let ((revs (or (log-view-get-marked)
+                   (vc-read-multiple-revisions "Revisions: ")))
+         to)
+     (require 'message)
+     (while (null (setq to (completing-read-multiple
+                            (format-prompt
+                             "Addressee"
+                             vc-default-patch-addressee)
+                            (message--name-table "")
+                            nil nil nil nil
+                            vc-default-patch-addressee)))
+       (message "At least one addressee required.")
+       (sit-for blink-matching-delay))
+     (list (string-join to ", ")
+           (and vc-prepare-patches-inline
+                (read-string "Subject: " "[PATCH] " nil nil t))
+           revs)))
+  (save-current-buffer
+    (vc-ensure-vc-buffer)
+    (let ((patches (mapcar (lambda (rev)
+                             (vc-call-backend
+                              (vc-responsible-backend default-directory)
+                              'prepare-patch rev))
+                           revisions)))
+      (if (not vc-prepare-patches-inline)
+          (dolist (patch patches)
+            (compose-mail addressee
+                          (plist-get patch :subject)
+                          nil nil nil nil
+                          `((kill-buffer ,(plist-get patch :buffer))
+                            (exit-recursive-edit)))
+            (rfc822-goto-eoh) (forward-line)
+            (save-excursion             ;don't jump to the end
+              (insert-buffer-substring
+               (plist-get patch :buffer)
+               (plist-get patch :body-start)
+               (plist-get patch :body-end)))
+            (recursive-edit))
+        (compose-mail addressee subject nil nil nil nil
+                      (mapcar
+                       (lambda (p)
+                         (list #'kill-buffer (plist-get p :buffer)))
+                       patches))
+        (rfc822-goto-eoh)
+        (forward-line)
+        (save-excursion
+          (dolist (patch patches)
+            (mml-attach-buffer (buffer-name (plist-get patch :buffer))
+                               "text/x-patch"
+                               (plist-get patch :subject)
+                               "attachment")))
+        (open-line 2)))))
+
 (defun vc-default-responsible-p (_backend _file)
   "Indicate whether BACKEND is responsible for FILE.
 The default is to return nil always."
-- 
2.37.3


[-- Attachment #3: Type: text/plain, Size: 1222 bytes --]


It includes

- some documentation for the Emacs manual and etc/NEWS,

- a revised "prepare-patch" interface that uses buffers instead of
  temporary files (I hope this improves the encoding issue),

- use log-view commits if anything is marked,

- removed hard-coded `message-goto-body' calls,

- added bzr and hg support,

- A new user option 'vc-default-patch-addressee'.

Antoine Kalmbach <ane@iki.fi> writes:

>> +(defun vc-compose-patch (addressee subject revisions)
>> +  "Compose a message sending REVISIONS to ADDRESSEE with SUBJECT."
>> +  (interactive (save-current-buffer
>
> Overall, this looks great.  If I understand this right, this doesn't
> support entering revision ranges (abcd1234..ghjk568, HEAD~2, etc), but
> you have to input each absolute revision?  I think that's actually fine,
> because it composes with the proposed vc-log feature of marking commits
> there and then applying vc-compose-patch on the commits.  Trying to
> convert those into VCS specific revision ranges is probably asking for trouble.

Yes, though the previous version of that patch didn't do this, and
instead just passed the commit directly to "git format-patch", which
isn't what the documentation claims the command does.