diff options
| -rw-r--r-- | Makefile | 2 | ||||
| -rw-r--r-- | README | 51 | ||||
| -rw-r--r-- | debian/changelog | 41 | ||||
| -rw-r--r-- | debian/control | 15 | ||||
| -rw-r--r-- | debian/copyright | 2 | ||||
| -rw-r--r-- | debian/elpa-mailscripts.docs | 1 | ||||
| -rw-r--r-- | debian/mailscripts.docs | 1 | ||||
| -rwxr-xr-x | email-print-mime-structure | 22 | ||||
| -rwxr-xr-x | imap-dl | 14 | ||||
| -rw-r--r-- | mailscripts.el | 372 |
10 files changed, 463 insertions, 58 deletions
@@ -27,5 +27,5 @@ clean: completions/bash/%: mkdir -p completions/bash - register-python-argcomplete3 $(notdir $@) >$@.tmp + register-python-argcomplete $(notdir $@) >$@.tmp mv $@.tmp $@ @@ -0,0 +1,51 @@ +mailscripts -- collection of scripts for manipulating e-mail on Unixes +====================================================================== + +This package is a place to collect together, and distribute, small scripts for +manipulating e-mail on Unixes. The idea is that those of us handling our +e-mail using tools like offlineimap, mbsync, notmuch, mu, mairix etc. often +end up writing small helper scripts, and some of the scripts are worth tidying +up, documenting and sharing with others, but they're small enough not to +deserve packages of their own. This is a place for them. + +mailscripts is primarily developed as part of the Debian project. In July +2018 some notmuch-using Debian Developers arrived at the DebCamp preceding +DebConf18, and started discussing useful mail-handling scripts, actual and +envisioned. We decided it would be a good idea to create a package like this. +If you have written a useful mail-handling script, please consider submitting +it to this collection. + +Some highlights: + +* mdmv -- safely move messages between maildirs + +* mbox2maildir -- convert an mbox to a maildir using Python's libraries + +* notmuch-extract-patch -- extract a git patch series from notmuch + +* email-print-mime-structure -- tree view of a message's MIME structure + +* imap-dl -- download messages from an IMAP mailbox to a maildir + +mailscripts.el -- Emacs utilities for handling mail on Unixes +============================================================= + +mailscripts.el is an Emacs Lisp library. It's original purpose was to make it +easy to use scripts shipped in Debian's mailscripts package from within Emacs. +It now also contains additional, thematically-related utilities which don't +invoke any of those scripts. + +Some highlights: + +* notmuch-extract-{thread,message}-patches{,-to-project} + -- extract & apply git patch(es) from Gnus+notmuch or notmuch-show + +* mailscripts-git-format-patch-drafts + -- import patches generated by git-format-patch(1) to Gnus or notmuch drafts + +* mailscripts-git-format-patch-attach + -- compose mail with patches generated by git-format-patch(1) attached + (Git-specific alternative to the built-in vc-prepare-patches) + +* mailscripts-git-format-patch-append + -- append an inline "-- >8 --" patch to an unsent message diff --git a/debian/changelog b/debian/changelog index 759a89b..31a35fc 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,44 @@ +mailscripts (29-1) unstable; urgency=medium + + * Clean up types for mypy 1.9.0 (Closes: #1067796). + Thanks to Daniel Kahn Gillmor for the patch. + - New build-dep on python3-gssapi. + - Update copyright years for dkg. + + -- Sean Whitton <spwhitton@spwhitton.name> Sat, 06 Apr 2024 16:23:46 +0800 + +mailscripts (28-1) unstable; urgency=medium + + * mailscripts.el: + - new commands: mailscripts-git-format-patch-{attach,drafts,append} + - new DWIM wrapper command: mailscripts-prepare-patch + + - notmuch-extract-{thread,message}-patches: add Gnus support + notmuch-extract-message-patches{,-to-project} are now aliases for + mailscripts-extract-message-patches{,-to-project}. + - if mailscripts-extract-message-patches identifies no attachments, + it now offers to pipe the whole message to 'git am' + + - don't offer to detach a HEAD that's already detached + - rewrite short description and add a brief commentary + - load the notmuch library only when code that requires it is called + - move the mailscripts customisation group into the mail group + - add declarations to fix byte compilation warnings + - fix usage of cl-case in an internal function. + * debian/control: update Description: for elpa-mailscripts. + Use the new short description and commentary from mailscripts.el. + * Add & install a README, to both binary packages. + * Tighten build-dep on python3-pgpy to require >= 0.5.4-4.1. + + -- Sean Whitton <spwhitton@spwhitton.name> Sat, 24 Dec 2022 12:09:07 -0700 + +mailscripts (27-1) unstable; urgency=medium + + * Update Makefile register-python-argcomplete3 -> register-python-argcomplete + (Closes: #1013622). + + -- Sean Whitton <spwhitton@spwhitton.name> Fri, 24 Jun 2022 14:51:22 -0700 + mailscripts (26-1) unstable; urgency=medium * New script: sendmail-reinject (Closes: #1009617) diff --git a/debian/control b/debian/control index 5753610..31187e3 100644 --- a/debian/control +++ b/debian/control @@ -16,7 +16,8 @@ Build-Depends: perl, python3 <!nocheck>, python3-argcomplete, - python3-pgpy <!nocheck>, + python3-gssapi <!nocheck>, + python3-pgpy (>= 0.5.4-4.1) <!nocheck>, Vcs-Git: https://git.spwhitton.name/mailscripts Vcs-Browser: https://git.spwhitton.name/mailscripts Homepage: https://git.spwhitton.name/mailscripts @@ -33,9 +34,15 @@ Recommends: Enhances: emacs, emacs25, -Description: Emacs functions for accessing tools in the mailscripts package - This package adds to Emacs functions to access tools in the - mailscripts package from Emacs. +Description: Emacs utilities for handling mail on Unixes + The original purpose of this package was to make it easy to use the small + mail-handling utilities shipped in the 'mailscripts' package from within + Emacs. It now also contains some additional, thematically-related utilities + which don't invoke any of those scripts. + . + Entry points you might like to look at if you're new to this package: + mailscripts-prepare-patch, notmuch-slurp-debbug, + notmuch-extract-{thread,message}-patches{,-to-project}. Package: mailscripts Depends: diff --git a/debian/copyright b/debian/copyright index f4fee59..ac4c52e 100644 --- a/debian/copyright +++ b/debian/copyright @@ -2,7 +2,7 @@ mailscripts Collection of scripts for manipulating e-mail on Debian Copyright (C)2017-2021 Sean Whitton -Copyright (C)2019-2020 Daniel Kahn Gillmor +Copyright (C)2019-2024 Daniel Kahn Gillmor Copyright (C)2020 Red Hat, Inc. Copyright (C)2022 Jameson Graef Rollins diff --git a/debian/elpa-mailscripts.docs b/debian/elpa-mailscripts.docs new file mode 100644 index 0000000..e845566 --- /dev/null +++ b/debian/elpa-mailscripts.docs @@ -0,0 +1 @@ +README diff --git a/debian/mailscripts.docs b/debian/mailscripts.docs new file mode 100644 index 0000000..e845566 --- /dev/null +++ b/debian/mailscripts.docs @@ -0,0 +1 @@ +README diff --git a/email-print-mime-structure b/email-print-mime-structure index b7646e0..3263da9 100755 --- a/email-print-mime-structure +++ b/email-print-mime-structure @@ -2,7 +2,7 @@ # PYTHON_ARGCOMPLETE_OK # -*- coding: utf-8 -*- -# Copyright (C) 2019 Daniel Kahn Gillmor +# Copyright (C) 2019-2024 Daniel Kahn Gillmor # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -39,6 +39,7 @@ import subprocess from argparse import ArgumentParser, Namespace from typing import Optional, Union, List, Tuple, Any +from types import ModuleType from email.charset import Charset from email.message import Message @@ -47,8 +48,9 @@ try: except ImportError: pgpy = None +argcomplete:Optional[ModuleType] try: - import argcomplete #type: ignore + import argcomplete except ImportError: argcomplete = None @@ -74,7 +76,7 @@ class MimePrinter(object): # FIXME: it looks like we are counting chars here, not bytes: nbytes = len(z.as_string()) else: - payload:Union[List[Message], str, bytes, None] = z.get_payload() + payload = z.get_payload() if not isinstance(payload, (str,bytes)): raise TypeError(f'expected payload to be either str or bytes, got {type(payload)}') # FIXME: it looks like we are counting chars here, not bytes: @@ -106,7 +108,7 @@ class MimePrinter(object): else: if z.get_content_type().lower() == 'application/pkcs7-mime' and \ str(z.get_param('smime-type')).lower() == 'signed-data': - bodypart:Union[List[Message],str,bytes,None] = z.get_payload(decode=True) + bodypart = z.get_payload(decode=True) if isinstance(bodypart, bytes): unwrapped = self.pipe_transform(bodypart, ['certtool', '--p7-show-data', '--p7-info', '--inder']) if unwrapped: @@ -118,7 +120,7 @@ class MimePrinter(object): def decrypt_part(self, msg:Message, flavor:EncType) -> Optional[Message]: - ciphertext:Union[List[Message],str,bytes,None] = msg.get_payload(decode=True) + ciphertext = msg.get_payload(decode=True) cryptopayload:Optional[Message] = None if not isinstance(ciphertext, bytes): logging.warning('encrypted part was not a leaf mime part somehow') @@ -178,14 +180,18 @@ class MimePrinter(object): prefix = prefix.rpartition('└')[0] + ' ' if prefix.endswith('├'): prefix = prefix.rpartition('├')[0] + '│' - parts:Union[List[Message], str, bytes, None] = z.get_payload() + parts = z.get_payload() if not isinstance(parts, list): raise TypeError(f'parts was {type(parts)}, expected List[Message]') i = 0 while (i < len(parts)-1): - self.print_tree(parts[i], prefix + '├', z, i+1) + msg = parts[i] + if isinstance(msg, Message): + self.print_tree(msg, prefix + '├', z, i+1) i += 1 - self.print_tree(parts[i], prefix + '└', z, i+1) + msg = parts[i] + if isinstance(msg, Message): + self.print_tree(msg, prefix + '└', z, i+1) # FIXME: show epilogue? else: self.print_part(z, prefix+'─╴', parent, num) @@ -2,7 +2,7 @@ # PYTHON_ARGCOMPLETE_OK # -*- coding: utf-8 -*- -# Copyright (C) 2019-2020 Daniel Kahn Gillmor +# Copyright (C) 2019-2024 Daniel Kahn Gillmor # Copyright (C) 2020 Red Hat, Inc. # # This program is free software: you can redistribute it and/or modify @@ -52,14 +52,17 @@ import statistics import configparser from typing import Dict, List, Optional, Tuple, Union +from types import ModuleType +argcomplete:Optional[ModuleType] try: - import argcomplete #type: ignore + import argcomplete except ImportError: argcomplete = None +gssapi:Optional[ModuleType] try: - import gssapi # type: ignore + import gssapi except ModuleNotFoundError: gssapi = None @@ -96,15 +99,16 @@ def auth_builtin(username:str, imap:imaplib.IMAP4, except Exception as e: raise Exception(f'login failed with {e} as user {username} on {server}') -if gssapi: +if gssapi is not None: # imaplib auth methods need to be in the form of callables, and they all # requre both additional parameters and storage beyond what the function # interface provides. class GSSAPI_handler(): - gss_vc:gssapi.SecurityContext username:str def __init__(self, server:str, username:str) -> None: + if gssapi is None: + raise Exception("Impossible state -- gssapi module is not loaded") name = gssapi.Name(f'imap@{server}', gssapi.NameType.hostbased_service) self.gss_vc = gssapi.SecurityContext(usage="initiate", name=name) diff --git a/mailscripts.el b/mailscripts.el index 15ed7ac..15c135f 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -1,7 +1,7 @@ -;;; mailscripts.el --- functions to access tools in the mailscripts package -*- lexical-binding: t; -*- +;;; mailscripts.el --- utilities for handling mail on Unixes -*- lexical-binding: t; -*- ;; Author: Sean Whitton <spwhitton@spwhitton.name> -;; Version: 26 +;; Version: 28 ;; Package-Requires: (notmuch) ;; Copyright (C) 2018, 2019, 2020, 2022 Sean Whitton @@ -19,14 +19,29 @@ ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;;; Commentary: + +;; The original purpose of this package was to make it easy to use the small +;; mail-handling utilities shipped in Debian's 'mailscripts' package from +;; within Emacs. It now also contains some additional, thematically-related +;; utilities which don't invoke any of those scripts. +;; +;; Entry points you might like to look at if you're new to this package: +;; mailscripts-prepare-patch, notmuch-slurp-debbug, +;; notmuch-extract-{thread,message}-patches{,-to-project}. + ;;; Code: (require 'cl-lib) -(require 'notmuch) (require 'thingatpt) +(require 'vc) +(require 'message) + +(eval-when-compile (require 'notmuch)) (defgroup mailscripts nil - "Customisation of functions in the mailscripts package.") + "Customisation of functions in the mailscripts package." + :group 'mail) (defcustom mailscripts-extract-patches-branch-prefix nil "Prefix for git branches created by functions which extract patch series. @@ -66,6 +81,7 @@ must be set to the one you use." If NO-OPEN, don't open the thread." (interactive "sBug number: ") + (require 'notmuch) (call-process-shell-command (concat "notmuch-slurp-debbug " bug)) (unless no-open (let* ((search (concat "Bug#" bug)) @@ -87,10 +103,14 @@ If NO-OPEN, don't open the thread." (skip-chars-forward "#bBug" (+ 4 (point))) (notmuch-slurp-debbug (number-to-string (number-at-point))))) +(declare-function notmuch-show-get-subject "notmuch-show") +(declare-function notmuch-refresh-this-buffer "notmuch-lib") + ;;;###autoload (defun notmuch-slurp-this-debbug () "When viewing a Debian bug in notmuch, download any missing messages." (interactive) + (require 'notmuch) (let ((subject (notmuch-show-get-subject))) (notmuch-slurp-debbug (if (string-match "Bug#\\([0-9]+\\):" subject) @@ -111,28 +131,36 @@ option detailed in mbox-extract-patch(1). See notmuch-extract-patch(1) manpage for limitations: in particular, this Emacs Lisp function supports passing only entire threads to the notmuch-extract-patch(1) command." + ;; We could obtain a list of message IDs for a subthread, say, and disjoin + ;; them to produce a more specific query to pass to the script. This could + ;; help in large threads where the script fails to extract the right thing. (interactive "Dgit repo: \nsnew branch name (or leave blank to apply to current HEAD): \nP") - (let ((thread-id - ;; If `notmuch-show' was called with a notmuch query rather - ;; than a thread ID, as `org-notmuch-follow-link' in - ;; org-notmuch.el does, then `notmuch-show-thread-id' might - ;; be an arbitrary notmuch query instead of a thread ID. We - ;; need to wrap such a query in thread:{} before passing it - ;; to notmuch-extract-patch(1), or we might not get a whole - ;; thread extracted (e.g. if the query is just id:foo) - (if (string= (substring notmuch-show-thread-id 0 7) "thread:") - notmuch-show-thread-id - (concat "thread:{" notmuch-show-thread-id "}"))) + (let ((search + (cond + ((derived-mode-p 'gnus-summary-mode 'gnus-article-mode) + (mailscripts--gnus-message-id-search t)) + ((derived-mode-p 'notmuch-show-mode) + ;; If `notmuch-show' was called with a notmuch query rather + ;; than a thread ID, as `org-notmuch-follow-link' in + ;; org-notmuch.el does, then `notmuch-show-thread-id' might + ;; be an arbitrary notmuch query instead of a thread ID. We + ;; need to wrap such a query in thread:{} before passing it + ;; to notmuch-extract-patch(1), or we might not get a whole + ;; thread extracted (e.g. if the query is just id:foo) + (if (string= (substring notmuch-show-thread-id 0 7) "thread:") + notmuch-show-thread-id + (concat "thread:{" notmuch-show-thread-id "}"))) + (t (user-error "Unsupported major mode")))) (default-directory (expand-file-name repo))) (mailscripts--check-out-branch branch) (shell-command (if reroll-count (format "notmuch-extract-patch -v%d %s | git am" (prefix-numeric-value reroll-count) - (shell-quote-argument thread-id)) + (shell-quote-argument search)) (format "notmuch-extract-patch %s | git am" - (shell-quote-argument thread-id))) + (shell-quote-argument search))) "*notmuch-apply-thread-series*"))) ;;;###autoload @@ -150,30 +178,84 @@ threads to the notmuch-extract-patch(1) command." (when current-prefix-arg (prefix-numeric-value current-prefix-arg)))) +(declare-function notmuch-foreach-mime-part "notmuch") +(declare-function notmuch--call-process "notmuch-lib") +(declare-function notmuch-show-get-message-id "notmuch-show") +(declare-function notmuch-show-pipe-message "notmuch-show") +(defvar gnus-article-buffer) +(declare-function article-decode-charset "gnus-art") +(declare-function gnus-article-mime-handles "gnus-art") +(declare-function gnus-summary-show-article "gnus-sum") + ;;;###autoload -(defun notmuch-extract-message-patches (repo branch) +(defalias 'notmuch-extract-message-patches + #'mailscripts-extract-message-patches) + +;;;###autoload +(defun mailscripts-extract-message-patches (repo branch) "Extract patches attached to current message to branch BRANCH in repo REPO. +If there are no attachments that look like patches, offer to try piping the +whole message. The target branch may or may not already exist. Patches are applied using git-am(1), so we only consider attachments with filenames which look like they were generated by git-format-patch(1)." + ;; See `debbugs-gnu-apply-patch' in debbugs-gnu.el for other ideas about + ;; identifying which attachments are the patches to be applied. + ;; We could make it a defcustom, so that users can supply their own filters. (interactive "Dgit repo: \nsnew branch name (or leave blank to apply to current HEAD): ") - (with-current-notmuch-show-message - (let ((default-directory (expand-file-name repo)) - (mm-handle (mm-dissect-buffer t))) - (mailscripts--check-out-branch branch) - (notmuch-foreach-mime-part - (lambda (p) - (let* ((disposition (mm-handle-disposition p)) - (filename (cdr (assq 'filename disposition)))) - (and filename - (string-match "^\\(v?[0-9]+\\)-.+\\.\\(patch\\|diff\\|txt\\)$" - filename) - (mm-pipe-part p "git am")))) - mm-handle)))) + (let ((default-directory (expand-file-name repo)) + handles raw) + (cond ((derived-mode-p 'gnus-summary-mode 'gnus-article-mode) + (with-current-buffer gnus-article-buffer + (setq handles (mapcar #'cdr (gnus-article-mime-handles)) + raw (lambda () + (gnus-summary-show-article 'raw) + (with-current-buffer gnus-article-buffer + (article-decode-charset) + (buffer-string)))))) + ((derived-mode-p 'notmuch-show-mode) + (with-current-notmuch-show-message + (notmuch-foreach-mime-part (lambda (handle) (push handle handles)) + (mm-dissect-buffer t))) + (setq raw (lambda () + (let (ret) + (with-current-notmuch-show-message + (setq ret (buffer-string))) + ret)))) + (t (user-error "Unsupported major mode"))) + (cl-callf2 cl-remove-if-not + (lambda (h) + (and-let* + ((filename (cdr (assq 'filename (mm-handle-disposition h))))) + (string-match "\\`v?[0-9]+-.+\\.\\(?:patch\\|diff\\|txt\\)\\'" + filename))) + handles) + (if handles + (cl-loop initially (mailscripts--check-out-branch branch) + for handle in handles do (mm-pipe-part handle "git am")) + ;; We ask for confirmation because our code for identifying attached + ;; patches, and for finding scissors, is very simple. + (setq raw (funcall raw)) + (with-temp-buffer + (insert raw) + (goto-char (point-min)) + (let ((scissors (re-search-forward "^-- >8 --\\s-*$" nil t))) + (cl-case (or (and scissors + (yes-or-no-p + (substitute-quotes + "Pipe whole message to `git am --scissors'?")) + 'scissors) + (yes-or-no-p + (substitute-quotes + (if scissors "Pipe whole message to `git am'?" +"Could not identify attached patches; pipe whole message to `git am'?")))) + (scissors + (call-process-region nil nil "git" nil nil nil "am" "-c")) + ((t) (call-process-region nil nil "git" nil nil nil "am")))))))) ;;;###autoload (define-obsolete-function-alias @@ -182,16 +264,220 @@ git-format-patch(1)." "mailscripts 0.22") ;;;###autoload -(defun notmuch-extract-message-patches-to-project () - "Like `notmuch-extract-message-patches', but choose repo from known projects." +(defalias 'notmuch-extract-message-patches-to-project + #'mailscripts-extract-message-patches-to-project) + +;;;###autoload +(defun mailscripts-extract-message-patches-to-project () + "Like `mailscripts-extract-message-patches', but choose repo from known projects." (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). + ;; Only use attachments when configured for this project. + ;; + ;; We presently assume that if patches-as-attachments has been + ;; configured for this project, it's unlikely that you'll want to send + ;; any messages with --scissors patches. That may not be correct. + (cond + ((and (local-variable-p 'vc-prepare-patches-separately) + (not vc-prepare-patches-separately)) + #'mailscripts-git-format-patch-attach) + ((and (catch 'found + (dolist (buffer (buffer-list)) + (when (and (string-search "unsent " (buffer-name buffer)) + (with-current-buffer buffer + (derived-mode-p 'mail-mode 'message-mode))) + (throw 'found t)))) + (yes-or-no-p "Append -- >8 -- patch to unsent message?")) + #'mailscripts-git-format-patch-append) + (t #'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-contents (car patches)) + (message-narrow-to-headers-or-head) + (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))))) + +(declare-function gnus-summary-header "gnus-score") +(declare-function gnus-summary-goto-article "gnus-sum") +(declare-function gnus-summary-copy-article "gnus-sum") +(declare-function gnus-summary-exit-no-update "gnus-sum") +(declare-function gnus-uu-mark-buffer "gnus-uu") +(declare-function gnus-group-read-group "gnus-group") +(declare-function gnus-group-read-ephemeral-group "gnus-group") + +(defun mailscripts--gfp-drafts-gnus (args) + (require 'gnus) + (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) + (require 'notmuch) + (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-git-format-patch-append (args) + "Append a patch generated by git-format-patch(1) to an unsent message. +ARGS is a single string of arguments to git-format-patch(1). +The patch is formatted such that a recipient can use the --scissors option to +git-am(1) to apply the patch; see \"DISCUSSION\" in git-format-patch(1)." + (interactive (list (read-string "git format-patch " "-1 "))) + (let ((dir default-directory)) + (compose-mail nil nil nil t) + (save-excursion + (save-restriction + (message-narrow-to-headers-or-head) + (let ((unsent-buffer (current-buffer)) + (default-directory dir) + (args (split-string-and-unquote args)) + (unsent-from (message-fetch-field "from"))) + (widen) + (if (re-search-forward message-signature-separator nil t) + (progn (goto-char (pos-bol)) + (push "--no-signature" args)) + (goto-char (point-max))) + (if (fboundp 'ensure-empty-lines) + (ensure-empty-lines 1) + ;; This is only some of what (ensure-empty-lines 1) does. + (if (bolp) + (unless (save-excursion (goto-char (pos-bol 0)) (eolp)) + (newline)) + (newline 2))) + (insert "-- >8 --\n") + (with-temp-buffer + (apply #'call-process "git" nil t nil "format-patch" "--stdout" + args) + (when (bobp) + (user-error "git-format-patch(1) produced no output")) + (goto-char (point-min)) + (delete-line) ; drop "From $SHA1 $magic_timestamp" + (message-narrow-to-headers-or-head) + (when-let* ((unsent + (and unsent-from + (mail-header-parse-address-lax unsent-from))) + (patch-from (message-fetch-field "from")) + (patch (mail-header-parse-address-lax patch-from))) + (when (equal unsent patch) + (message-remove-header "^From:\\|^Date:" t))) + (widen) + (goto-char (point-max)) + (delete-blank-lines) + (append-to-buffer unsent-buffer 1 (point-max)))))))) + +(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) - (and (eq mailscripts-detach-head-from-existing-branch 'ask) - (yes-or-no-p "Detach HEAD before applying patches?"))) + (when (and + ;; Don't proceed if HEAD is already detached. + (zerop (call-process "git" nil nil nil + "symbolic-ref" "--quiet" "HEAD")) + (or (eq mailscripts-detach-head-from-existing-branch t) + (and (eq mailscripts-detach-head-from-existing-branch 'ask) + (yes-or-no-p "Detach HEAD before applying patches?")))) (call-process-shell-command "git checkout --detach")) (call-process-shell-command (format "git checkout -b %s" @@ -200,16 +486,24 @@ git-format-patch(1)." (concat mailscripts-extract-patches-branch-prefix branch) branch)))))) +(defun mailscripts--gnus-message-id-search (&optional thread) + (format (if thread "thread:{id:%s}" "id:%s") + (string-trim (gnus-summary-header "message-id") "<" ">"))) + +(defvar projectile-known-projects) +(declare-function project-prompt-project-dir "project") +(declare-function projectile-completing-read "projectile") + (defun mailscripts--project-repo-and-branch (f &rest args) (let ((repo (cl-case mailscripts-project-library - ('project + (project (require 'project) (project-prompt-project-dir)) - ('projectile + (projectile (require 'projectile) (projectile-completing-read "Select Projectile project: " projectile-known-projects)) - (nil + (t (user-error "Please customize variable `mailscripts-project-library'.")))) (branch (read-from-minibuffer |