From 3d404ef37e6f7303bba74a8cf413aaa8b8672ef5 Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Sun, 18 Dec 2022 10:46:17 -0700 Subject: mailscripts.el: three new patch preparation commands Signed-off-by: Sean Whitton --- mailscripts.el | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) (limited to 'mailscripts.el') diff --git a/mailscripts.el b/mailscripts.el index d2da7a4..5a55b79 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -24,6 +24,9 @@ (require 'cl-lib) (require 'notmuch) (require 'thingatpt) +(require 'vc) +(require 'message) +(require 'gnus) (defgroup mailscripts nil "Customisation of functions in the mailscripts package.") @@ -187,6 +190,129 @@ git-format-patch(1)." (interactive) (mailscripts--project-repo-and-branch 'notmuch-extract-message-patches)) +;;;###autoload +(defun mailscripts-prepare-patch () + "Prepare patches for mailing out in a project- and MUA-specific way. +This is a convenience wrapper command for interactive use only. +Its behaviour is subject to change as we add support for more MUAs, ways to +generate patches, etc.." + (interactive) + (call-interactively + (if (eq (vc-deduce-backend) 'Git) + ;; For Git, default to one message per patch, like git-send-email(1). + (if (and (local-variable-p 'vc-prepare-patches-separately) + (not vc-prepare-patches-separately)) + #'mailscripts-git-format-patch-attach + #'mailscripts-git-format-patch-drafts) + #'vc-prepare-patch))) + +;;;###autoload +(defun mailscripts-git-format-patch-attach (args &optional new) + "Compose mail with patches generated by git-format-patch(1) attached. +ARGS is a single string of arguments to git-format-patch(1). If NEW is +non-nil (interactively, with a prefix argument), always start composing a +new message. Otherwise, attach patches to an existing mail composition +buffer. This is useful for sending patches in reply to bug reports, etc.. + +This command is a Git-specific alternative to `vc-prepare-patch' with nil +`vc-prepare-patches-separately'. It makes it easier to take advantage of +various features of git-format-patch(1), such as reroll counts. +For a command for non-nil `vc-prepare-patches-separately', see +`mailscripts-git-format-patch-drafts'. +See also the interactive wrapper command `mailscripts-prepare-patch'." + (interactive "sgit format-patch \nP") + (let ((temp (make-temp-file "patches" t)) + (mml-attach-file-at-the-end t) + patches subject) + (condition-case err + (setq patches (apply #'process-lines "git" "format-patch" "-o" temp + (split-string-and-unquote args)) + subject + (if (file-exists-p (car patches)) + (with-temp-buffer + (insert-file (car patches)) + (and-let* ((subject (message-fetch-field "subject"))) + (if (cdr patches) + (and (string-match + "^\\[\\(.*PATCH.*?\\)\\(?:\\s-+[0-9]+/[0-9]+\\)?\\]\\s-" + subject) + (format "[%s] " (match-string 1 subject))) + subject))) + (user-error "git-format-patch(1) created no patch files"))) + (error (delete-directory temp t) + (signal (car err) (cdr err)))) + (compose-mail (mailscripts--gfp-addressee) subject nil (not new) nil nil + `((delete-directory ,temp t))) + (mapc #'mml-attach-file patches) + (when (or (not subject) (cdr patches)) + (message-goto-subject)))) + +;;;###autoload +(defun mailscripts-git-format-patch-drafts (args) + "Import patches generated by git-format-patch(1) to your drafts folder. +ARGS is a single string of arguments to git-format-patch(1). + +This command is a Git-specific alternative to `vc-prepare-patch' with non-nil +`vc-prepare-patches-separately'. It makes it easier to take advantage of +various features of git-format-patch(1), such as reroll counts. +For a command for nil `vc-prepare-patches-separately', see +`mailscripts-git-format-patch-attach'. +See also the interactive wrapper command `mailscripts-prepare-patch'." + (interactive "sgit format-patch ") + (let ((args (cons "--thread" (split-string-and-unquote args)))) + (when-let ((addressee (mailscripts--gfp-addressee))) + (push (format "--to=%s" addressee) args)) + (cl-case mail-user-agent + (gnus-user-agent (mailscripts--gfp-drafts-gnus args)) + (notmuch-user-agent (mailscripts--gfp-drafts-notmuch args)) + (t (user-error "Unsupported mail-user-agent `%s'" mail-user-agent))))) + +(defun mailscripts--gfp-drafts-gnus (args) + (let* ((temp (make-temp-file "patches")) + (group (concat "nndoc+ephemeral:" temp)) + (method `(nndoc ,temp (nndoc-article-type mbox))) + (summary (format "*Summary %s*" group)) + message-id) + (unwind-protect + (progn (with-temp-file temp + (unless (zerop (apply #'call-process "git" nil t nil + "format-patch" "--stdout" args)) + (user-error "git-format-patch(1) exited non-zero"))) + (unless (gnus-alive-p) (gnus-no-server)) + (gnus-group-read-ephemeral-group group method) + (setq message-id (gnus-summary-header "message-id")) + (gnus-uu-mark-buffer) + (gnus-summary-copy-article nil "nndraft:drafts")) + (when-let ((buffer (get-buffer summary))) + (with-current-buffer buffer + (gnus-summary-exit-no-update t))) + (delete-file temp)) + (gnus-group-read-group t t "nndraft:drafts") + (gnus-summary-goto-article message-id))) + +(defun mailscripts--gfp-drafts-notmuch (args) + (let ((temp (make-temp-file "patches" t)) + (insert (cl-list* "insert" (format "--folder=%s" notmuch-draft-folder) + "--create-folder" notmuch-draft-tags))) + (unwind-protect + (mapc (lambda (patch) + (unless (zerop (apply #'call-process "notmuch" patch + "*notmuch-insert output*" nil insert)) + (display-buffer "*notmuch-insert output*") + (user-error "notmuch-insert(1) exited non-zero"))) + (apply #'process-lines "git" "format-patch" "-o" temp args)) + (delete-directory temp t))) + (notmuch-search (format "folder:%s" notmuch-draft-folder))) + +(defun mailscripts--gfp-addressee () + "Try to find a recipient for the --to argument to git-format-patch(1)." + (or (and (local-variable-p 'vc-default-patch-addressee) + vc-default-patch-addressee) + (car (process-lines-ignore-status + "git" "config" "--get" "format.to")) + (car (process-lines-ignore-status + "git" "config" "--get" "sendemail.to")))) + (defun mailscripts--check-out-branch (branch) (if (string= branch "") (when (or (eq mailscripts-detach-head-from-existing-branch t) -- cgit v1.2.3