master aaca72806e 1/2: vc-prepare-patch: Number the attached patches

[Sean Whitton]

branch: master
commit aaca72806ecd60f28384fe839cdfe6a28a2b5d1f
Author: Sean Whitton <spwhitton@spwhitton.name>
Commit: Sean Whitton <spwhitton@spwhitton.name>

    vc-prepare-patch: Number the attached patches
    
    * lisp/gnus/mml.el (mml-attach-buffer): New FILENAME argument.
    * lisp/vc/vc.el (vc--subject-to-file-name): New function.
    (vc-prepare-patch): When vc-prepare-patches-separately is nil,
    generate file names for the attached patches.
    Call vc--subject-to-file-name, and then prepend numbers indicating the
    ordering of the patches (bug#60147).
---
 lisp/gnus/mml.el | 13 ++++++++-----
 lisp/vc/vc.el    | 31 +++++++++++++++++++++++++------
 2 files changed, 33 insertions(+), 11 deletions(-)

diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el
index ebd0adf2e2..dc86fe6db9 100644
--- a/lisp/gnus/mml.el
+++ b/lisp/gnus/mml.el
@@ -1484,10 +1484,12 @@ Ask for type, description or disposition according to
          (setq disposition (mml-minibuffer-read-disposition type nil file)))
        (mml-attach-file file type description disposition)))))
 
-(defun mml-attach-buffer (buffer &optional type description disposition)
+(defun mml-attach-buffer (buffer &optional type description disposition 
filename)
   "Attach a buffer to the outgoing MIME message.
 BUFFER is the name of the buffer to attach.  See
-`mml-attach-file' for details of operation."
+`mml-attach-file' regarding TYPE, DESCRIPTION and DISPOSITION.
+FILENAME is a suggested file name for the attachment should a
+recipient wish to save a copy separate from the message."
   (interactive
    (let* ((buffer (read-buffer "Attach buffer: "))
          (type (mml-minibuffer-read-type buffer "text/plain"))
@@ -1497,9 +1499,10 @@ BUFFER is the name of the buffer to attach.  See
   ;; If in the message header, attach at the end and leave point unchanged.
   (let ((head (unless (message-in-body-p) (point))))
     (if head (goto-char (point-max)))
-    (mml-insert-empty-tag 'part 'type type 'buffer buffer
-                         'disposition disposition
-                         'description description)
+    (apply #'mml-insert-empty-tag
+           'part 'type type 'buffer buffer
+          'disposition disposition 'description description
+           (and filename `(filename ,filename)))
     ;; When using Mail mode, make sure it does the mime encoding
     ;; when you send the message.
     (or (eq mail-user-agent 'message-user-agent)
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index 690c907c77..b40bb31b60 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -3369,7 +3369,7 @@ If nil, no default will be used.  This option may be set 
locally."
 
 (declare-function message--name-table "message" (orig-string))
 (declare-function mml-attach-buffer "mml"
-                  (buffer &optional type description disposition))
+                  (buffer &optional type description disposition filename))
 (declare-function log-view-get-marked "log-view" ())
 
 (defun vc-default-prepare-patch (_backend rev)
@@ -3410,6 +3410,19 @@ of the current file."
        (and-let* ((file (buffer-file-name)))
          (vc-working-revision file)))))
 
+(defun vc--subject-to-file-name (subject)
+  "Generate a file name for a patch with subject line SUBJECT."
+  (let* ((stripped
+          (replace-regexp-in-string "\\`\\[.*PATCH.*\\]\\s-*" ""
+                                    subject))
+         (truncated (if (length> stripped 50)
+                        (substring stripped 0 50)
+                      stripped)))
+    (concat
+     (string-trim (replace-regexp-in-string "\\W" "-" truncated)
+                  "-+" "-+")
+     ".patch")))
+
 ;;;###autoload
 (defun vc-prepare-patch (addressee subject revisions)
   "Compose an Email sending patches for REVISIONS to ADDRESSEE.
@@ -3466,11 +3479,17 @@ marked revisions, use those these."
         (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")))
+          (let ((i 0))
+            (dolist (patch patches)
+              (let* ((patch-subject (plist-get patch :subject))
+                     (filename
+                      (vc--subject-to-file-name patch-subject)))
+                (mml-attach-buffer
+                 (buffer-name (plist-get patch :buffer))
+                 "text/x-patch"
+                 patch-subject
+                 "attachment"
+                 (format "%04d-%s" (cl-incf i) filename))))))
         (open-line 2)))))
 
 (defun vc-default-responsible-p (_backend _file)