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

[Philip Kaludercic <philipk@posteo.net>]

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

Robert Pluim <rpluim@gmail.com> writes:

>>>>>> On Wed, 05 Oct 2022 17:34:22 +0000, Philip Kaludercic
> <philipk@posteo.net> said:
>
>     Philip> +@code{vc-prepare-patch} command.  This will prompt you
>     Philip> which revisions
>     Philip> +you wish to share and who the addressee is.  The command
>     Philip> will then use
>     Philip> +your @abbr{MUA, Mail User Agent} for you to review and send out.
>     Philip> +
>
> How about
>
> --begin--
> This will prompt you for the revisions you wish to share, and which
> destination email address(es) to use.  The command will then prepare
> those revisions using your @abbr{MUA, Mail User Agent} for you to
> review and send.
> --end--

I like it.

> The semantics is 'one-or-more addresses', right?

Yes, right.

>     Philip> +@vindex vc-prepare-patches-inline
>     Philip> +Depending on configuration of the user option
>
> "Depending on the value of the user option"

Sounds better.


>     Philip> +@code{vc-prepare-patches-inline}, @code{vc-prepare-patch}
>     Philip> will either
>     Philip> +generate a single or multiple messages.  A @code{nil}
>     Philip> value (the default)
>     Philip> +will prepare and display a message for each revision, one after
>     Philip> +another.  A non-@code{nil} value will have all patches
>     Philip> attached to the
>     Philip> +body of a single message.
>     Philip> +
>
> --begin--
> @code{vc-prepare-patches-inline}, @code{vc-prepare-patch} will
> generate one or more messages.  The default value @code{nil} means
> prepare and display a message for each revision, one after another.  A
> non-@code{nil} value means to generate a single message with all
> patches attached in the body.
> --end--

Sounds a lot better.

>     Philip> +@vindex vc-default-patch-addressee
>     Philip> +If you expect to contribute patches on a regular basis, you can set
>     Philip> +the user option @code{vc-default-patch-addressee} to the address you
>     Philip> +wish to use.  This will be used as the default value when invoking
>     Philip> +@code{vc-prepare-patch}.  Project maintainers may consider setting
>     Philip> +this as a directory local variable (@pxref{Directory Variables}).
>     Philip> +
>
> This can contain multiple addresses, I think, in which case it should
> say so.

Would replacing "address" with "address(es)" suffice?

>     Philip> +** Subr-x
>     Philip> +
>     Philip> +---
>     Philip> +*** New macro 'with-funcall-substitutions'.
>     Philip> +The macro can be used to generically substitute function symbols in
>     Philip> +expressions.
>     Philip> +
>     Philip>  ** Ansi-color
>
> That sounds interesting, but I donʼt see it in the patch :-)

As mentioned in another response, this is from a different patch I hope
to submit soon.  I just had it lying around in etc/NEWS.

>     Philip> +(defcustom vc-prepare-patches-inline nil
>     Philip> +  "Non-nil means that `vc-prepare-patch' creates a single
>     Philip> message.
>
> "Whether `vc-prepare-patch' attaches all revision in a single message."
>
> Iʼm not sure this should have the suffix '-inline', because you can
> have inline attachments and attached attachments, but itʼs not a big
> deal.

If you have a better name, there is no better time to change it than now.

> I also wonder about the default. Creating 100 mail buffers by accident
> is harder to recover from than a single one with 100 attachments, but
> I guess experience will inform us.

The only case where this might happen by accident is when someone
invokes `vc-prepare-patch' in a log-edit buffer where all (or at least a
lot) of revisions have been marked.  In that case, one could add a
"safely check" and make sure that the user actually wants to proceed.

>     Philip> +A single message is created by attaching all patches to the body
>     Philip> +of a single message.  If nil, each patch will be sent out in a
>     Philip> +separate message, which will be prepared sequentially."
>     Philip> +  :type 'boolean
>     Philip> +  :safe #'booleanp
>     Philip> +  :version "29.1")
>     Philip> +
>
> (I didnʼt check, can this do the [PATCH n/m] stuff with the
> subject that 'git format-patch' can do?)

Yes, as the Git backend just copies the subject name that
git-format-patch generates.

>     Philip> +(defcustom vc-default-patch-addressee nil
>     Philip> +  "Default addressee for `vc-prepare-patch'.
>     Philip> +If nil, no default will be used.  This option may be set locally."
>     Philip> +  :type '(choice (const :tag "No default" nil) string)
>     Philip> +  :safe #'stringp
>     Philip> +  :version "29.1")
>     Philip> +
>
> Again, I think this can be multiple addresses. Either as a string
> with commas or as a list of strings perhaps? 

As this is just the default value for `read-multiple-choice' a list with
commae should do.  That being said, how common is it to have multiple
people you consistently want to send a patch to?  Usually you'd have a
central mailing list or something like that, I'd assume.

>     Philip> +;;;###autoload
>     Philip> +(defun vc-prepare-patch (addressee subject revisions)
>     Philip> +  "Compose an Email sending patches for REVISIONS to ADDRESSEE.
>     Philip> +If `vc-prepare-patches-inline' is non-nil, SUBJECT will be used
>     Philip> +as the default subject for the message.  Otherwise a separate
>     Philip> +message will be composed for each revision.
>     Philip> +
>
> ? What does `vc-prepare-patches-inline' have to do with the SUBJECT?

Because the subject for an "inline patch" is extracted from the commit
message.

>     Philip> It includes
>
>     Philip> - some documentation for the Emacs manual and etc/NEWS,
>
>     Philip> - a revised "prepare-patch" interface that uses buffers instead of
>     Philip>   temporary files (I hope this improves the encoding issue),
>
> If itʼs all buffers now then I think you need to update this comment:
>
> +;;
> +;; - 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.

You are right, thanks for the reminder!

> I have no firm opinion on if there should be a default binding nor
> what it should be 😺
>
> Thanks for this, it will be useful

I'm glad to hear that.  Here is the updated 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: 14924 bytes --]

From 9e802cb4fd5657e7536bbff54fef1e8cfe7eafca 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 |  27 +++++++++
 etc/NEWS                |  18 ++++++
 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           | 124 ++++++++++++++++++++++++++++++++++++++--
 7 files changed, 216 insertions(+), 4 deletions(-)

diff --git a/doc/emacs/vc1-xtra.texi b/doc/emacs/vc1-xtra.texi
index 05d2144380..00f5e5aac6 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,32 @@ 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 for the
+revisions you wish to share, and which destination email address(es)
+to use.  The command will then prepare those revisions using your
+@abbr{MUA, Mail User Agent} for you to review and send.
+
+@vindex vc-prepare-patches-inline
+Depending on the value of the user option
+@code{vc-prepare-patches-inline}, @code{vc-prepare-patch} will
+generate one or more messages.  The default value @code{nil} means
+prepare and display a message for each revision, one after another.  A
+non-@code{nil} value means to generate a single message with all
+patches attached in the body.
+
+@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(es)
+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 536c7aa319..58a0745a1b 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1865,6 +1865,24 @@ 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.
 
+---
+*** The function 'vc-read-revision' accepts a new MULTIPLE argument.
+If non-nil, multiple revisions can be queried.  This is done using
+'completing-read-multiple'.
+
+---
+*** New function 'vc-read-multiple-revisions'
+This function invokes 'vc-read-revision' with a non-nil value for
+MULTIPLE.
+
++++
+*** New command 'vc-prepare-patch'.
+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
 
 ---
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 787dd51d07..52ea2b83cf 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -574,6 +574,16 @@
 ;;   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, `:buffer'
+;;   with a buffer object that contains the entire patch message and
+;;   `:body-start' and `:body-end' demarcating what part of said
+;;   buffer should be inserted into an inline patch.  If the two last
+;;   properties are omitted, `point-min' and `point-max' will
+;;   respectively be used instead.
 
 ;;; Changes from the pre-25.1 API:
 ;;
@@ -1910,7 +1920,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 +1933,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."
@@ -3264,6 +3281,105 @@ vc-edit-next-command
           (lambda (&rest args)
             (apply #'vc-user-edit-command (apply old 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 :tag "Addressee"))
+  :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