git.notmuchmail.org Git - notmuch/blob - emacs/notmuch-draft.el

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