]> git.cworth.org Git - notmuch/blob - emacs/notmuch-draft.el
version: bump to 0.27
[notmuch] / emacs / notmuch-draft.el
1 ;;; notmuch-draft.el --- functions for postponing and editing drafts
2 ;;
3 ;; Copyright © Mark Walters
4 ;; Copyright © David Bremner
5 ;;
6 ;; This file is part of Notmuch.
7 ;;
8 ;; Notmuch is free software: you can redistribute it and/or modify it
9 ;; under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12 ;;
13 ;; Notmuch is distributed in the hope that it will be useful, but
14 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16 ;; General Public License for more details.
17 ;;
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with Notmuch.  If not, see <https://www.gnu.org/licenses/>.
20 ;;
21 ;; Authors: Mark Walters <markwalters1009@gmail.com>
22 ;;          David Bremner <david@tethera.net>
23
24 ;;; Code:
25
26 (require 'notmuch-maildir-fcc)
27 (require 'notmuch-tag)
28
29 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
30 (declare-function notmuch-message-mode "notmuch-mua")
31
32 (defgroup notmuch-draft nil
33   "Saving and editing drafts in Notmuch."
34   :group 'notmuch)
35
36 (defcustom notmuch-draft-tags '("+draft")
37   "List of tags changes to apply to a draft message when it is saved in the database.
38
39 Tags starting with \"+\" (or not starting with either \"+\" or
40 \"-\") in the list will be added, and tags starting with \"-\"
41 will be removed from the message being stored.
42
43 For example, if you wanted to give the message a \"draft\" tag
44 but not the (normally added by default) \"inbox\" tag, you would
45 set:
46     (\"+draft\" \"-inbox\")"
47   :type '(repeat string)
48   :group 'notmuch-draft)
49
50 (defcustom notmuch-draft-folder "drafts"
51   "Folder to save draft messages in.
52
53 This should be specified relative to the root of the notmuch
54 database. It will be created if necessary."
55   :type 'string
56   :group 'notmuch-draft)
57
58 (defcustom notmuch-draft-quoted-tags '()
59   "Mml tags to quote.
60
61 This should be a list of mml tags to quote before saving. You do
62 not need to include \"secure\" as that is handled separately.
63
64 If you include \"part\" then attachments will not be saved with
65 the draft -- if not then they will be saved with the draft. The
66 former means the attachments may not still exist when you resume
67 the message, the latter means that the attachments as they were
68 when you postponed will be sent with the resumed message.
69
70 Note you may get strange results if you change this between
71 postponing and resuming a message."
72   :type '(repeat string)
73   :group 'notmuch-send)
74
75 (defcustom notmuch-draft-save-plaintext 'ask
76   "Should notmuch save/postpone in plaintext messages that seem
77   like they are intended to be sent encrypted
78 (i.e with an mml encryption tag in it)."
79   :type '(radio
80           (const :tag "Never" nil)
81           (const :tag "Ask every time" ask)
82           (const :tag "Always" t))
83   :group 'notmuch-draft
84   :group 'notmuch-crypto)
85
86 (defvar notmuch-draft-encryption-tag-regex
87   "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
88   "Regular expression matching mml tags indicating encryption of part or message")
89
90 (defvar notmuch-draft-id nil
91   "Message-id of the most recent saved draft of this message")
92 (make-variable-buffer-local 'notmuch-draft-id)
93
94 (defun notmuch-draft--mark-deleted ()
95   "Tag the last saved draft deleted.
96
97 Used when a new version is saved, or the message is sent."
98   (when notmuch-draft-id
99     (notmuch-tag notmuch-draft-id '("+deleted"))))
100
101 (defun notmuch-draft-quote-some-mml ()
102   "Quote the mml tags in `notmuch-draft-quoted-tags`."
103   (save-excursion
104     ;; First we deal with any secure tag separately.
105     (message-goto-body)
106     (when (looking-at "<#secure[^\n]*>\n")
107       (let ((secure-tag (match-string 0)))
108         (delete-region (match-beginning 0) (match-end 0))
109         (message-add-header (concat "X-Notmuch-Emacs-Secure: " secure-tag))))
110     ;; This is copied from mml-quote-region but only quotes the
111     ;; specified tags.
112     (when notmuch-draft-quoted-tags
113       (let ((re (concat "<#!*/?\\("
114                         (mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
115                         "\\)")))
116         (message-goto-body)
117         (while (re-search-forward re nil t)
118           ;; Insert ! after the #.
119           (goto-char (+ (match-beginning 0) 2))
120           (insert "!"))))))
121
122 (defun notmuch-draft-unquote-some-mml ()
123   "Unquote the mml tags in `notmuch-draft-quoted-tags`."
124   (save-excursion
125     (when notmuch-draft-quoted-tags
126       (let ((re (concat "<#!+/?\\("
127                         (mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
128                         "\\)")))
129         (message-goto-body)
130         (while (re-search-forward re nil t)
131           ;; Remove one ! from after the #.
132           (goto-char (+ (match-beginning 0) 2))
133           (delete-char 1))))
134     (let (secure-tag)
135       (save-restriction
136         (message-narrow-to-headers)
137         (setq secure-tag (message-fetch-field "X-Notmuch-Emacs-Secure" 't))
138         (message-remove-header "X-Notmuch-Emacs-Secure"))
139       (message-goto-body)
140       (when secure-tag
141         (insert secure-tag "\n")))))
142
143 (defun notmuch-draft--has-encryption-tag ()
144   "Returns t if there is an mml secure tag."
145   (save-excursion
146     (message-goto-body)
147     (re-search-forward notmuch-draft-encryption-tag-regex nil 't)))
148
149 (defun notmuch-draft--query-encryption ()
150   "Checks if we should save a message that should be encrypted.
151
152 `notmuch-draft-save-plaintext' controls the behaviour."
153   (case notmuch-draft-save-plaintext
154         ((ask)
155          (unless (yes-or-no-p "(Customize `notmuch-draft-save-plaintext' to avoid this warning)
156 This message contains mml tags that suggest it is intended to be encrypted.
157 Really save and index an unencrypted copy? ")
158            (error "Save aborted")))
159         ((nil)
160          (error "Refusing to save draft with encryption tags (see `notmuch-draft-save-plaintext')"))
161         ((t)
162          (ignore))))
163
164 (defun notmuch-draft--make-message-id ()
165   ;; message-make-message-id gives the id inside a "<" ">" pair,
166   ;; but notmuch doesn't want that form, so remove them.
167   (concat "draft-" (substring (message-make-message-id) 1 -1)))
168
169 (defun notmuch-draft-save ()
170   "Save the current draft message in the notmuch database.
171
172 This saves the current message in the database with tags
173 `notmuch-draft-tags` (in addition to any default tags
174 applied to newly inserted messages)."
175   (interactive)
176   (when (notmuch-draft--has-encryption-tag)
177     (notmuch-draft--query-encryption))
178   (let ((id (notmuch-draft--make-message-id)))
179     (with-temporary-notmuch-message-buffer
180      ;; We insert a Date header and a Message-ID header, the former
181      ;; so that it is easier to search for the message, and the
182      ;; latter so we have a way of accessing the saved message (for
183      ;; example to delete it at a later time). We check that the
184      ;; user has these in `message-deletable-headers` (the default)
185      ;; as otherwise they are doing something strange and we
186      ;; shouldn't interfere. Note, since we are doing this in a new
187      ;; buffer we don't change the version in the compose buffer.
188      (cond
189       ((member 'Message-ID message-deletable-headers)
190        (message-remove-header "Message-ID")
191        (message-add-header (concat "Message-ID: <" id ">")))
192       (t
193        (message "You have customized emacs so Message-ID is not a deletable header, so not changing it")
194        (setq id nil)))
195      (cond
196       ((member 'Date message-deletable-headers)
197        (message-remove-header "Date")
198        (message-add-header (concat "Date: " (message-make-date))))
199       (t
200        (message "You have customized emacs so Date is not a deletable header, so not changing it")))
201      (message-add-header "X-Notmuch-Emacs-Draft: True")
202      (notmuch-draft-quote-some-mml)
203      (notmuch-maildir-setup-message-for-saving)
204      (notmuch-maildir-notmuch-insert-current-buffer
205       notmuch-draft-folder 't notmuch-draft-tags))
206     ;; We are now back in the original compose buffer. Note the
207     ;; function notmuch-call-notmuch-process (called by
208     ;; notmuch-maildir-notmuch-insert-current-buffer) signals an error
209     ;; on failure, so to get to this point it must have
210     ;; succeeded. Also, notmuch-draft-id is still the id of the
211     ;; previous draft, so it is safe to mark it deleted.
212     (notmuch-draft--mark-deleted)
213     (setq notmuch-draft-id (concat "id:" id))
214     (set-buffer-modified-p nil)))
215
216 (defun notmuch-draft-postpone ()
217   "Save the draft message in the notmuch database and exit buffer."
218   (interactive)
219   (notmuch-draft-save)
220   (kill-buffer))
221
222 (defun notmuch-draft-resume (id)
223   "Resume editing of message with id ID."
224   (let* ((tags (process-lines notmuch-command "search" "--output=tags"
225                               "--exclude=false" id))
226          (draft (equal tags (notmuch-update-tags tags notmuch-draft-tags))))
227     (when (or draft
228               (yes-or-no-p "Message does not appear to be a draft: really resume? "))
229       (switch-to-buffer (get-buffer-create (concat "*notmuch-draft-" id "*")))
230       (setq buffer-read-only nil)
231       (erase-buffer)
232       (let ((coding-system-for-read 'no-conversion))
233         (call-process notmuch-command nil t nil "show" "--format=raw" id))
234       (mime-to-mml)
235       (goto-char (point-min))
236       (when (re-search-forward "^$" nil t)
237         (replace-match mail-header-separator t t))
238       ;; Remove the Date and Message-ID headers (unless the user has
239       ;; explicitly customized emacs to tell us not to) as they will
240       ;; be replaced when the message is sent.
241       (save-restriction
242         (message-narrow-to-headers)
243         (when (member 'Message-ID message-deletable-headers)
244           (message-remove-header "Message-ID"))
245         (when (member 'Date message-deletable-headers)
246           (message-remove-header "Date"))
247         ;; The X-Notmuch-Emacs-Draft header is a more reliable
248         ;; indication of whether the message really is a draft.
249         (setq draft (> (message-remove-header "X-Notmuch-Emacs-Draft") 0)))
250       ;; If the message is not a draft we should not unquote any mml.
251       (when draft
252         (notmuch-draft-unquote-some-mml))
253       (notmuch-message-mode)
254       (message-goto-body)
255       (set-buffer-modified-p nil)
256       ;; If the resumed message was a draft then set the draft
257       ;; message-id so that we can delete the current saved draft if the
258       ;; message is resaved or sent.
259       (setq notmuch-draft-id (when draft id)))))
260
261
262 (add-hook 'message-send-hook 'notmuch-draft--mark-deleted)
263
264
265 (provide 'notmuch-draft)
266
267 ;;; notmuch-draft.el ends here