summaryrefslogtreecommitdiff
path: root/mailscripts.el
blob: 6bc64bc197f12014ac9e7eb596df7009658bd9eb (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
;;; mailscripts.el --- functions to access tools in the mailscripts package

;; Author: Sean Whitton <spwhitton@spwhitton.name>
;; Version: 0.12
;; Package-Requires: (notmuch projectile)

;; 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
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; 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)
  "Slurp Debian bug with bug number BUG and open the thread in notmuch.

If NO-OPEN, don't open the thread."
  (interactive "sBug number: ")
  (call-process-shell-command (concat "notmuch-slurp-debbug " bug))
  (unless no-open
    (notmuch-show (concat "Bug#" bug))))

;;;###autoload
(defun notmuch-slurp-this-debbug ()
  "When viewing a Debian bug in notmuch, download any missing messages."
  (interactive)
  (let ((subject (notmuch-show-get-subject)))
    (when (string-match "Bug#\\([0-9]+\\):" subject)
      (notmuch-slurp-debbug (match-string 1 subject) t))
    (notmuch-refresh-this-buffer)))

;;;###autoload
(defun notmuch-extract-thread-patches (repo branch &optional no-prefix)
  "Extract patch series in current thread to branch BRANCH in repo REPO.

A prefix arg suppresses the effects of
`mailscripts-extract-patches-branch-prefix'.

The target branch may or may not already exist.

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: \nP")
  (let ((thread-id notmuch-show-thread-id)
        (default-directory (expand-file-name repo)))
    (mailscripts--check-out-branch branch no-prefix)
    (shell-command
     (format "notmuch-extract-patch %s | git am"
             (shell-quote-argument thread-id))
     "*notmuch-apply-thread-series*")))

;;;###autoload
(defun notmuch-extract-thread-patches-projectile (&optional no-prefix)
  "Like `notmuch-extract-thread-patches', but use projectile to choose the repo."
  (interactive "P")
  (mailscripts--projectile-repo-and-branch
   'notmuch-extract-thread-patches no-prefix))

;;;###autoload
(defun notmuch-extract-message-patches (repo branch &optional no-prefix)
  "Extract patches attached to current message to branch BRANCH in repo REPO.

A prefix arg suppresses the effects of
`mailscripts-extract-patches-branch-prefix'.

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: \nsnew branch name: \nP")
  (with-current-notmuch-show-message
   (let ((default-directory (expand-file-name repo))
         (mm-handle (mm-dissect-buffer)))
     (mailscripts--check-out-branch branch no-prefix)
     (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 (&optional no-prefix)
  "Like `notmuch-extract-message-patches', but use projectile to choose the repo."
  (interactive "P")
  (mailscripts--projectile-repo-and-branch
   'notmuch-extract-message-patches no-prefix))

(defun mailscripts--check-out-branch (branch no-prefix)
  (call-process-shell-command
   (format "git checkout -b %s"
           (shell-quote-argument
            (if (and (not no-prefix) mailscripts-extract-patches-branch-prefix)
                (concat mailscripts-extract-patches-branch-prefix branch)
              branch)))))

(defun mailscripts--projectile-repo-and-branch (f &optional no-prefix)
  (let ((repo (projectile-completing-read
               "Select projectile project: " projectile-known-projects))
        (branch (completing-read "Branch name: " nil)))
    (funcall f repo branch no-prefix)))

(provide 'mailscripts)

;;; mailscripts.el ends here