1 ;;; notmuch-draft.el --- functions for postponing and editing drafts -*- lexical-binding: t -*-
3 ;; Copyright © Mark Walters
4 ;; Copyright © David Bremner
5 ;; Copyright © Leo Gaspard
7 ;; This file is part of Notmuch.
9 ;; Notmuch is free software: you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
14 ;; Notmuch is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with Notmuch. If not, see <https://www.gnu.org/licenses/>.
22 ;; Authors: Mark Walters <markwalters1009@gmail.com>
23 ;; David Bremner <david@tethera.net>
24 ;; Leo Gaspard <leo@gaspard.io>
31 (require 'notmuch-maildir-fcc)
32 (require 'notmuch-tag)
34 (declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
35 (declare-function notmuch-message-mode "notmuch-mua")
39 (defgroup notmuch-draft nil
40 "Saving and editing drafts in Notmuch."
43 (defcustom notmuch-draft-tags '("+draft")
44 "List of tags changes to apply to a draft message when it is saved in the database.
46 Tags starting with \"+\" (or not starting with either \"+\" or
47 \"-\") in the list will be added, and tags starting with \"-\"
48 will be removed from the message being stored.
50 For example, if you wanted to give the message a \"draft\" tag
51 but not the (normally added by default) \"inbox\" tag, you would
53 (\"+draft\" \"-inbox\")"
54 :type '(repeat string)
55 :group 'notmuch-draft)
57 (defcustom notmuch-draft-folder "drafts"
58 "Folder to save draft messages in.
60 This should be specified relative to the root of the notmuch
61 database. It will be created if necessary."
63 :group 'notmuch-draft)
65 (defcustom notmuch-draft-quoted-tags '()
68 This should be a list of mml tags to quote before saving. You do
69 not need to include \"secure\" as that is handled separately.
71 If you include \"part\" then attachments will not be saved with
72 the draft -- if not then they will be saved with the draft. The
73 former means the attachments may not still exist when you resume
74 the message, the latter means that the attachments as they were
75 when you postponed will be sent with the resumed message.
77 Note you may get strange results if you change this between
78 postponing and resuming a message."
79 :type '(repeat string)
82 (defcustom notmuch-draft-save-plaintext 'ask
83 "Whether to allow saving plaintext when it seems encryption is intended.
84 When a message contains mml tags, then that suggest it is
85 intended to be encrypted. If the user requests that such a
86 message is saved locally, then this option controls whether
87 that is allowed. Beside a boolean, this can also be `ask'."
89 (const :tag "Never" nil)
90 (const :tag "Ask every time" ask)
91 (const :tag "Always" t))
93 :group 'notmuch-crypto)
97 (defvar notmuch-draft-encryption-tag-regex
98 "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
99 "Regular expression matching mml tags indicating encryption of part or message.")
101 (defvar-local notmuch-draft-id nil
102 "Message-id of the most recent saved draft of this message.")
104 (defun notmuch-draft--mark-deleted ()
105 "Tag the last saved draft deleted.
107 Used when a new version is saved, or the message is sent."
108 (when notmuch-draft-id
109 (notmuch-tag notmuch-draft-id '("+deleted"))))
111 (defun notmuch-draft-quote-some-mml ()
112 "Quote the mml tags in `notmuch-draft-quoted-tags'."
114 ;; First we deal with any secure tag separately.
116 (when (looking-at "<#secure[^\n]*>\n")
117 (let ((secure-tag (match-string 0)))
118 (delete-region (match-beginning 0) (match-end 0))
119 (message-add-header (concat "X-Notmuch-Emacs-Secure: " secure-tag))))
120 ;; This is copied from mml-quote-region but only quotes the
122 (when notmuch-draft-quoted-tags
123 (let ((re (concat "<#!*/?\\("
124 (mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
127 (while (re-search-forward re nil t)
128 ;; Insert ! after the #.
129 (goto-char (+ (match-beginning 0) 2))
132 (defun notmuch-draft-unquote-some-mml ()
133 "Unquote the mml tags in `notmuch-draft-quoted-tags'."
135 (when notmuch-draft-quoted-tags
136 (let ((re (concat "<#!+/?\\("
137 (mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
140 (while (re-search-forward re nil t)
141 ;; Remove one ! from after the #.
142 (goto-char (+ (match-beginning 0) 2))
146 (message-narrow-to-headers)
147 (setq secure-tag (message-fetch-field "X-Notmuch-Emacs-Secure" t))
148 (message-remove-header "X-Notmuch-Emacs-Secure"))
151 (insert secure-tag "\n")))))
153 (defun notmuch-draft--has-encryption-tag ()
154 "Return non-nil if there is an mml secure tag."
157 (re-search-forward notmuch-draft-encryption-tag-regex nil t)))
159 (defun notmuch-draft--query-encryption ()
160 "Return non-nil if we should save a message that should be encrypted.
162 `notmuch-draft-save-plaintext' controls the behaviour."
163 (cl-case notmuch-draft-save-plaintext
166 "(Customize `notmuch-draft-save-plaintext' to avoid this warning)
167 This message contains mml tags that suggest it is intended to be encrypted.
168 Really save and index an unencrypted copy? ")
169 (error "Save aborted")))
171 (error "Refusing to save draft with encryption tags (see `%s')"
172 'notmuch-draft-save-plaintext))
176 (defun notmuch-draft--make-message-id ()
177 ;; message-make-message-id gives the id inside a "<" ">" pair,
178 ;; but notmuch doesn't want that form, so remove them.
179 (concat "draft-" (substring (message-make-message-id) 1 -1)))
183 (defun notmuch-draft-save ()
184 "Save the current draft message in the notmuch database.
186 This saves the current message in the database with tags
187 `notmuch-draft-tags' (in addition to any default tags
188 applied to newly inserted messages)."
190 (when (notmuch-draft--has-encryption-tag)
191 (notmuch-draft--query-encryption))
192 (let ((id (notmuch-draft--make-message-id)))
193 (with-temporary-notmuch-message-buffer
194 ;; We insert a Date header and a Message-ID header, the former
195 ;; so that it is easier to search for the message, and the
196 ;; latter so we have a way of accessing the saved message (for
197 ;; example to delete it at a later time). We check that the
198 ;; user has these in `message-deletable-headers' (the default)
199 ;; as otherwise they are doing something strange and we
200 ;; shouldn't interfere. Note, since we are doing this in a new
201 ;; buffer we don't change the version in the compose buffer.
203 ((member 'Message-ID message-deletable-headers)
204 (message-remove-header "Message-ID")
205 (message-add-header (concat "Message-ID: <" id ">")))
207 (message "You have customized emacs so Message-ID is not a %s"
208 "deletable header, so not changing it")
211 ((member 'Date message-deletable-headers)
212 (message-remove-header "Date")
213 (message-add-header (concat "Date: " (message-make-date))))
215 (message "You have customized emacs so Date is not a deletable %s"
216 "header, so not changing it")))
217 (message-add-header "X-Notmuch-Emacs-Draft: True")
218 (notmuch-draft-quote-some-mml)
219 (notmuch-maildir-setup-message-for-saving)
220 (notmuch-maildir-notmuch-insert-current-buffer
221 notmuch-draft-folder t notmuch-draft-tags))
222 ;; We are now back in the original compose buffer. Note the
223 ;; function notmuch-call-notmuch-process (called by
224 ;; notmuch-maildir-notmuch-insert-current-buffer) signals an error
225 ;; on failure, so to get to this point it must have
226 ;; succeeded. Also, notmuch-draft-id is still the id of the
227 ;; previous draft, so it is safe to mark it deleted.
228 (notmuch-draft--mark-deleted)
229 (setq notmuch-draft-id (concat "id:" id))
230 (set-buffer-modified-p nil)))
232 (defun notmuch-draft-postpone ()
233 "Save the draft message in the notmuch database and exit buffer."
238 (defun notmuch-draft-resume (id)
239 "Resume editing of message with id ID."
240 ;; Used by command `notmuch-show-resume-message'.
241 (let* ((tags (process-lines notmuch-command "search" "--output=tags"
242 "--exclude=false" id))
243 (draft (equal tags (notmuch-update-tags tags notmuch-draft-tags))))
245 (yes-or-no-p "Message does not appear to be a draft: edit as new? "))
246 (pop-to-buffer-same-window
247 (get-buffer-create (concat "*notmuch-draft-" id "*")))
248 (setq buffer-read-only nil)
250 (let ((coding-system-for-read 'no-conversion))
251 (call-process notmuch-command nil t nil "show" "--format=raw" id))
253 (goto-char (point-min))
254 (when (re-search-forward "^$" nil t)
255 (replace-match mail-header-separator t t))
256 ;; Remove the Date and Message-ID headers (unless the user has
257 ;; explicitly customized emacs to tell us not to) as they will
258 ;; be replaced when the message is sent.
260 (message-narrow-to-headers)
261 (when (member 'Message-ID message-deletable-headers)
262 (message-remove-header "Message-ID"))
263 (when (member 'Date message-deletable-headers)
264 (message-remove-header "Date"))
265 (unless draft (notmuch-fcc-header-setup))
266 ;; The X-Notmuch-Emacs-Draft header is a more reliable
267 ;; indication of whether the message really is a draft.
268 (setq draft (> (message-remove-header "X-Notmuch-Emacs-Draft") 0)))
269 ;; If the message is not a draft we should not unquote any mml.
271 (notmuch-draft-unquote-some-mml))
272 (notmuch-message-mode)
274 (set-buffer-modified-p nil)
275 ;; If the resumed message was a draft then set the draft
276 ;; message-id so that we can delete the current saved draft if the
277 ;; message is resaved or sent.
278 (setq notmuch-draft-id (and draft id)))))
282 (add-hook 'message-send-hook 'notmuch-draft--mark-deleted)
284 (provide 'notmuch-draft)
286 ;;; notmuch-draft.el ends here