unofficial mirror of notmuch@notmuchmail.org
 help / color / mirror / code / Atom feed
blob a68b7d8da002a7f3f76b2ccded426bb465724de7 10742 bytes (raw)
name: emacs/notmuch-draft.el 	 # note: path name is non-authoritative(*)

  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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
 
;;; notmuch-draft.el --- functions for postponing and editing drafts  -*- lexical-binding: t -*-
;;
;; Copyright © Mark Walters
;; Copyright © David Bremner
;; Copyright © Leo Gaspard
;;
;; This file is part of Notmuch.
;;
;; Notmuch 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.
;;
;; Notmuch 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 Notmuch.  If not, see <https://www.gnu.org/licenses/>.
;;
;; Authors: Mark Walters <markwalters1009@gmail.com>
;;	    David Bremner <david@tethera.net>
;;	    Leo Gaspard <leo@gaspard.io>

;;; Code:

(require 'cl-lib)
(require 'pcase)
(require 'subr-x)

(require 'notmuch-maildir-fcc)
(require 'notmuch-tag)

(declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
(declare-function notmuch-message-mode "notmuch-mua")

;;; Options

(defgroup notmuch-draft nil
  "Saving and editing drafts in Notmuch."
  :group 'notmuch)

(defcustom notmuch-draft-tags '("+draft")
  "List of tags changes to apply to a draft message when it is saved in the database.

Tags starting with \"+\" (or not starting with either \"+\" or
\"-\") in the list will be added, and tags starting with \"-\"
will be removed from the message being stored.

For example, if you wanted to give the message a \"draft\" tag
but not the (normally added by default) \"inbox\" tag, you would
set:
    (\"+draft\" \"-inbox\")"
  :type '(repeat string)
  :group 'notmuch-draft)

(defcustom notmuch-draft-folder "drafts"
  "Folder to save draft messages in.

This should be specified relative to the root of the notmuch
database. It will be created if necessary."
  :type 'string
  :group 'notmuch-draft)

(defcustom notmuch-draft-quoted-tags '()
  "Mml tags to quote.

This should be a list of mml tags to quote before saving. You do
not need to include \"secure\" as that is handled separately.

If you include \"part\" then attachments will not be saved with
the draft -- if not then they will be saved with the draft. The
former means the attachments may not still exist when you resume
the message, the latter means that the attachments as they were
when you postponed will be sent with the resumed message.

Note you may get strange results if you change this between
postponing and resuming a message."
  :type '(repeat string)
  :group 'notmuch-send)

(defcustom notmuch-draft-save-plaintext 'ask
  "Whether to allow saving plaintext when it seems encryption is intended.
When a message contains mml tags, then that suggest it is
intended to be encrypted.  If the user requests that such a
message is saved locally, then this option controls whether
that is allowed.  Beside a boolean, this can also be `ask'."
  :type '(radio
	  (const :tag "Never" nil)
	  (const :tag "Ask every time" ask)
	  (const :tag "Always" t))
  :group 'notmuch-draft
  :group 'notmuch-crypto)

;;; Internal

(defvar notmuch-draft-encryption-tag-regex
  "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
  "Regular expression matching mml tags indicating encryption of part or message.")

(defvar-local notmuch-draft-id nil
  "Message-id of the most recent saved draft of this message.")

(defun notmuch-draft--mark-deleted ()
  "Tag the last saved draft deleted.

Used when a new version is saved, or the message is sent."
  (when notmuch-draft-id
    (notmuch-tag notmuch-draft-id '("+deleted"))))

(defun notmuch-draft-quote-some-mml ()
  "Quote the mml tags in `notmuch-draft-quoted-tags'."
  (save-excursion
    ;; First we deal with any secure tag separately.
    (message-goto-body)
    (when (looking-at "<#secure[^\n]*>\n")
      (let ((secure-tag (match-string 0)))
	(delete-region (match-beginning 0) (match-end 0))
	(message-add-header (concat "X-Notmuch-Emacs-Secure: " secure-tag))))
    ;; This is copied from mml-quote-region but only quotes the
    ;; specified tags.
    (when notmuch-draft-quoted-tags
      (let ((re (concat "<#!*/?\\("
			(mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
			"\\)")))
	(message-goto-body)
	(while (re-search-forward re nil t)
	  ;; Insert ! after the #.
	  (goto-char (+ (match-beginning 0) 2))
	  (insert "!"))))))

(defun notmuch-draft-unquote-some-mml ()
  "Unquote the mml tags in `notmuch-draft-quoted-tags'."
  (save-excursion
    (when notmuch-draft-quoted-tags
      (let ((re (concat "<#!+/?\\("
			(mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
			"\\)")))
	(message-goto-body)
	(while (re-search-forward re nil t)
	  ;; Remove one ! from after the #.
	  (goto-char (+ (match-beginning 0) 2))
	  (delete-char 1))))
    (let (secure-tag)
      (save-restriction
	(message-narrow-to-headers)
	(setq secure-tag (message-fetch-field "X-Notmuch-Emacs-Secure" t))
	(message-remove-header "X-Notmuch-Emacs-Secure"))
      (message-goto-body)
      (when secure-tag
	(insert secure-tag "\n")))))

(defun notmuch-draft--has-encryption-tag ()
  "Return non-nil if there is an mml secure tag."
  (save-excursion
    (message-goto-body)
    (re-search-forward notmuch-draft-encryption-tag-regex nil t)))

(defun notmuch-draft--query-encryption ()
  "Return non-nil if we should save a message that should be encrypted.

`notmuch-draft-save-plaintext' controls the behaviour."
  (cl-case notmuch-draft-save-plaintext
    ((ask)
     (unless (yes-or-no-p
	      "(Customize `notmuch-draft-save-plaintext' to avoid this warning)
This message contains mml tags that suggest it is intended to be encrypted.
Really save and index an unencrypted copy? ")
       (error "Save aborted")))
    ((nil)
     (error "Refusing to save draft with encryption tags (see `%s')"
	    'notmuch-draft-save-plaintext))
    ((t)
     (ignore))))

(defun notmuch-draft--make-message-id ()
  ;; message-make-message-id gives the id inside a "<" ">" pair,
  ;; but notmuch doesn't want that form, so remove them.
  (concat "draft-" (substring (message-make-message-id) 1 -1)))

;;; Commands

(defun notmuch-draft-save ()
  "Save the current draft message in the notmuch database.

This saves the current message in the database with tags
`notmuch-draft-tags' (in addition to any default tags
applied to newly inserted messages)."
  (interactive)
  (when (notmuch-draft--has-encryption-tag)
    (notmuch-draft--query-encryption))
  (let ((id (notmuch-draft--make-message-id)))
    (with-temporary-notmuch-message-buffer
     ;; We insert a Date header and a Message-ID header, the former
     ;; so that it is easier to search for the message, and the
     ;; latter so we have a way of accessing the saved message (for
     ;; example to delete it at a later time). We check that the
     ;; user has these in `message-deletable-headers' (the default)
     ;; as otherwise they are doing something strange and we
     ;; shouldn't interfere. Note, since we are doing this in a new
     ;; buffer we don't change the version in the compose buffer.
     (cond
      ((member 'Message-ID message-deletable-headers)
       (message-remove-header "Message-ID")
       (message-add-header (concat "Message-ID: <" id ">")))
      (t
       (message "You have customized emacs so Message-ID is not a %s"
		"deletable header, so not changing it")
       (setq id nil)))
     (cond
      ((member 'Date message-deletable-headers)
       (message-remove-header "Date")
       (message-add-header (concat "Date: " (message-make-date))))
      (t
       (message "You have customized emacs so Date is not a deletable %s"
		"header, so not changing it")))
     (message-add-header "X-Notmuch-Emacs-Draft: True")
     (notmuch-draft-quote-some-mml)
     (notmuch-maildir-setup-message-for-saving)
     (notmuch-maildir-notmuch-insert-current-buffer
      notmuch-draft-folder t notmuch-draft-tags))
    ;; We are now back in the original compose buffer. Note the
    ;; function notmuch-call-notmuch-process (called by
    ;; notmuch-maildir-notmuch-insert-current-buffer) signals an error
    ;; on failure, so to get to this point it must have
    ;; succeeded. Also, notmuch-draft-id is still the id of the
    ;; previous draft, so it is safe to mark it deleted.
    (notmuch-draft--mark-deleted)
    (setq notmuch-draft-id (concat "id:" id))
    (set-buffer-modified-p nil)))

(defun notmuch-draft-postpone ()
  "Save the draft message in the notmuch database and exit buffer."
  (interactive)
  (notmuch-draft-save)
  (kill-buffer))

(defun notmuch-draft-resume (id)
  "Resume editing of message with id ID."
  ;; Used by command `notmuch-show-resume-message'.
  (let* ((tags (process-lines notmuch-command "search" "--output=tags"
			      "--exclude=false" id))
	 (draft (equal tags (notmuch-update-tags tags notmuch-draft-tags))))
    (when (or draft
	      (yes-or-no-p "Message does not appear to be a draft: edit as new? "))
      (pop-to-buffer-same-window
       (get-buffer-create (concat "*notmuch-draft-" id "*")))
      (setq buffer-read-only nil)
      (erase-buffer)
      (let ((coding-system-for-read 'no-conversion))
	(call-process notmuch-command nil t nil "show" "--format=raw" id))
      (mime-to-mml)
      (goto-char (point-min))
      (when (re-search-forward "^$" nil t)
	(replace-match mail-header-separator t t))
      ;; Remove the Date and Message-ID headers (unless the user has
      ;; explicitly customized emacs to tell us not to) as they will
      ;; be replaced when the message is sent.
      (save-restriction
	(message-narrow-to-headers)
	(when (member 'Message-ID message-deletable-headers)
	  (message-remove-header "Message-ID"))
	(when (member 'Date message-deletable-headers)
	  (message-remove-header "Date"))
	(unless draft (notmuch-fcc-header-setup))
	;; The X-Notmuch-Emacs-Draft header is a more reliable
	;; indication of whether the message really is a draft.
	(setq draft (> (message-remove-header "X-Notmuch-Emacs-Draft") 0)))
      ;; If the message is not a draft we should not unquote any mml.
      (when draft
	(notmuch-draft-unquote-some-mml))
      (notmuch-message-mode)
      (message-goto-body)
      (set-buffer-modified-p nil)
      ;; If the resumed message was a draft then set the draft
      ;; message-id so that we can delete the current saved draft if the
      ;; message is resaved or sent.
      (setq notmuch-draft-id (and draft id)))))

;;; _

(add-hook 'message-send-hook 'notmuch-draft--mark-deleted)

(provide 'notmuch-draft)

;;; notmuch-draft.el ends here

debug log:

solving a68b7d8d ...
found a68b7d8d in https://yhetil.org/notmuch.git/

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://yhetil.org/notmuch.git/

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).