diff options
Diffstat (limited to 'mailscripts.el')
| -rw-r--r-- | mailscripts.el | 88 |
1 files changed, 79 insertions, 9 deletions
diff --git a/mailscripts.el b/mailscripts.el index f0002fc..916aec8 100644 --- a/mailscripts.el +++ b/mailscripts.el @@ -1,10 +1,10 @@ ;;; mailscripts.el --- functions to access tools in the mailscripts package ;; Author: Sean Whitton <spwhitton@spwhitton.name> -;; Version: 0.11 -;; Package-Requires: (notmuch) +;; Version: 0.13 +;; Package-Requires: (notmuch projectile) -;; Copyright (C) 2018 Sean Whitton +;; Copyright (C) 2018, 2019 Sean Whitton ;; 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 @@ -22,6 +22,17 @@ ;;; Code: (require 'notmuch) +(require 'projectile) + +(defgroup mailscripts nil + "Customisation of functions in the mailscripts package.") + +(defcustom mailscripts-extract-patches-branch-prefix nil + "Prefix for git branches created by functions which extract patch series. + +E.g. `email/'." + :type 'string + :group 'mailscripts) ;;;###autoload (defun notmuch-slurp-debbug (bug &optional no-open) @@ -43,25 +54,84 @@ If NO-OPEN, don't open the thread." (notmuch-refresh-this-buffer))) ;;;###autoload -(defun notmuch-extract-thread-patches (repo branch) +(defun notmuch-extract-thread-patches (repo branch &optional reroll-count) "Extract patch series in current thread to branch BRANCH in repo REPO. The target branch may or may not already exist. +With an optional prefix numeric argument REROLL-COUNT, try to +extract the nth revision of a series. See the --reroll-count +option detailed in notmuch-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." - (interactive "Dgit repo: \nsnew branch name: ") + (interactive + "Dgit repo: \nsbranch name (or leave blank to apply to current HEAD): \np") (let ((thread-id notmuch-show-thread-id) (default-directory (expand-file-name repo))) - (call-process-shell-command - (format "git checkout -b %s" - (shell-quote-argument branch))) + (mailscripts--check-out-branch branch) (shell-command - (format "notmuch-extract-patch %s | git am" + (format "notmuch-extract-patch -v%d %s | git am" + (if reroll-count reroll-count 1) (shell-quote-argument thread-id)) "*notmuch-apply-thread-series*"))) +;;;###autoload +(defun notmuch-extract-thread-patches-projectile () + "Like `notmuch-extract-thread-patches', but use projectile to choose the repo." + (interactive) + (mailscripts--projectile-repo-and-branch + 'notmuch-extract-thread-patches (prefix-numeric-value current-prefix-arg))) + +;;;###autoload +(defun notmuch-extract-message-patches (repo branch) + "Extract patches attached to current message to branch BRANCH in repo REPO. + +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)." + (interactive + "Dgit repo: \nsbranch 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))) + (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]+-\\)?[0-9]+-.+\.\\(patch\\|diff\\|txt\\)$" filename) + (mm-pipe-part p "git am")))) + mm-handle)))) + +;;;###autoload +(defun notmuch-extract-message-patches-projectile () + "Like `notmuch-extract-message-patches', but use projectile to choose the repo." + (interactive) + (mailscripts--projectile-repo-and-branch 'notmuch-extract-message-patches)) + +(defun mailscripts--check-out-branch (branch) + (unless (string= branch "") + (call-process-shell-command + (format "git checkout -b %s" + (shell-quote-argument + (if mailscripts-extract-patches-branch-prefix + (concat mailscripts-extract-patches-branch-prefix branch) + branch)))))) + +(defun mailscripts--projectile-repo-and-branch (f &rest args) + (let ((repo (projectile-completing-read + "Select projectile project: " projectile-known-projects)) + (branch (completing-read + "Branch name (or leave blank to apply to current HEAD): " + nil))) + (apply f repo branch args))) + (provide 'mailscripts) ;;; mailscripts.el ends here |