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).
This commit is contained in:
Sean Whitton 2022-12-16 22:34:52 -07:00
parent ae91da5233
commit aaca72806e
2 changed files with 33 additions and 11 deletions

View file

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

View file

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