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 ;;
   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
  31 (defgroup notmuch-draft nil
  32   "Saving and editing drafts in Notmuch."
  33   :group 'notmuch)
  34
  35 (defcustom notmuch-draft-tags '("+draft")
  36   "List of tags changes to apply to a draft message when it is saved in the database.
  37
  38 Tags starting with \"+\" (or not starting with either \"+\" or
  39 \"-\") in the list will be added, and tags starting with \"-\"
  40 will be removed from the message being stored.
  41
  42 For example, if you wanted to give the message a \"draft\" tag
  43 but not the (normally added by default) \"inbox\" tag, you would
  44 set:
  45     (\"+draft\" \"-inbox\")"
  46   :type '(repeat string)
  47   :group 'notmuch-draft)
  48
  49 (defcustom notmuch-draft-folder "drafts"
  50   "Folder to save draft messages in.
  51
  52 This should be specified relative to the root of the notmuch
  53 database. It will be created if necessary."
  54   :type 'string
  55   :group 'notmuch-draft)
  56
  57 (defcustom notmuch-draft-quoted-tags '()
  58   "Mml tags to quote.
  59
  60 This should be a list of mml tags to quote before saving. You do
  61 not need to include \"secure\" as that is handled separately.
  62
  63 If you include \"part\" then attachments will not be saved with
  64 the draft -- if not then they will be saved with the draft. The
  65 former means the attachments may not still exist when you resume
  66 the message, the latter means that the attachments as they were
  67 when you postponed will be sent with the resumed message.
  68
  69 Note you may get strange results if you change this between
  70 postponing and resuming a message."
  71   :type '(repeat string)
  72   :group 'notmuch-send)
  73
  74 (defcustom notmuch-draft-save-plaintext 'ask
  75   "Should notmuch save/postpone in plaintext messages that seem
  76   like they are intended to be sent encrypted
  77 (i.e with an mml encryption tag in it)."
  78   :type '(radio
  79           (const :tag "Never" nil)
  80           (const :tag "Ask every time" ask)
  81           (const :tag "Always" t))
  82   :group 'notmuch-draft
  83   :group 'notmuch-crypto)
  84
  85 (defvar notmuch-draft-encryption-tag-regex
  86   "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
  87   "Regular expression matching mml tags indicating encryption of part or message")
  88
  89 (defvar notmuch-draft-id nil
  90   "Message-id of the most recent saved draft of this message")
  91 (make-variable-buffer-local 'notmuch-draft-id)
  92
  93 (defun notmuch-draft--mark-deleted ()
  94   "Tag the last saved draft deleted.
  95
  96 Used when a new version is saved, or the message is sent."
  97   (when notmuch-draft-id
  98     (notmuch-tag notmuch-draft-id '("+deleted"))))
  99
 100 (defun notmuch-draft-quote-some-mml ()
 101   "Quote the mml tags in `notmuch-draft-quoted-tags`."
 102   (save-excursion
 103     ;; First we deal with any secure tag separately.
 104     (message-goto-body)
 105     (when (looking-at "<#secure[^\n]*>\n")
 106       (let ((secure-tag (match-string 0)))
 107         (delete-region (match-beginning 0) (match-end 0))
 108         (message-add-header (concat "X-Notmuch-Emacs-Secure: " secure-tag))))
 109     ;; This is copied from mml-quote-region but only quotes the
 110     ;; specified tags.
 111     (when notmuch-draft-quoted-tags
 112       (let ((re (concat "<#!*/?\\("
 113                         (mapconcat 'regexp-quote notmuch-draft-quoted-tags "\\|")
 114                         "\\)")))
 115         (message-goto-body)
 116         (while (re-search-forward re nil t)
 117           ;; Insert ! after the #.
 118           (goto-char (+ (match-beginning 0) 2))
 119           (insert "!"))))))
 120
 121 (defun notmuch-draft--has-encryption-tag ()
 122   "Returns t if there is an mml secure tag."
 123   (save-excursion
 124     (message-goto-body)
 125     (re-search-forward notmuch-draft-encryption-tag-regex nil 't)))
 126
 127 (defun notmuch-draft--query-encryption ()
 128   "Checks if we should save a message that should be encrypted.
 129
 130 `notmuch-draft-save-plaintext' controls the behaviour."
 131   (case notmuch-draft-save-plaintext
 132         ((ask)
 133          (unless (yes-or-no-p "(Customize `notmuch-draft-save-plaintext' to avoid this warning)
 134 This message contains mml tags that suggest it is intended to be encrypted.
 135 Really save and index an unencrypted copy? ")
 136            (error "Save aborted")))
 137         ((nil)
 138          (error "Refusing to save draft with encryption tags (see `notmuch-draft-save-plaintext')"))
 139         ((t)
 140          (ignore))))
 141
 142 (defun notmuch-draft--make-message-id ()
 143   ;; message-make-message-id gives the id inside a "<" ">" pair,
 144   ;; but notmuch doesn't want that form, so remove them.
 145   (concat "draft-" (substring (message-make-message-id) 1 -1)))
 146
 147 (defun notmuch-draft-save ()
 148   "Save the current draft message in the notmuch database.
 149
 150 This saves the current message in the database with tags
 151 `notmuch-draft-tags` (in addition to any default tags
 152 applied to newly inserted messages)."
 153   (interactive)
 154   (when (notmuch-draft--has-encryption-tag)
 155     (notmuch-draft--query-encryption))
 156   (let ((id (notmuch-draft--make-message-id)))
 157     (with-temporary-notmuch-message-buffer
 158      ;; We insert a Date header and a Message-ID header, the former
 159      ;; so that it is easier to search for the message, and the
 160      ;; latter so we have a way of accessing the saved message (for
 161      ;; example to delete it at a later time). We check that the
 162      ;; user has these in `message-deletable-headers` (the default)
 163      ;; as otherwise they are doing something strange and we
 164      ;; shouldn't interfere. Note, since we are doing this in a new
 165      ;; buffer we don't change the version in the compose buffer.
 166      (cond
 167       ((member 'Message-ID message-deletable-headers)
 168        (message-remove-header "Message-ID")
 169        (message-add-header (concat "Message-ID: <" id ">")))
 170       (t
 171        (message "You have customized emacs so Message-ID is not a deletable header, so not changing it")
 172        (setq id nil)))
 173      (cond
 174       ((member 'Date message-deletable-headers)
 175        (message-remove-header "Date")
 176        (message-add-header (concat "Date: " (message-make-date))))
 177       (t
 178        (message "You have customized emacs so Date is not a deletable header, so not changing it")))
 179      (message-add-header "X-Notmuch-Emacs-Draft: True")
 180      (notmuch-draft-quote-some-mml)
 181      (notmuch-maildir-setup-message-for-saving)
 182      (notmuch-maildir-notmuch-insert-current-buffer
 183       notmuch-draft-folder 't notmuch-draft-tags))
 184     ;; We are now back in the original compose buffer. Note the
 185     ;; function notmuch-call-notmuch-process (called by
 186     ;; notmuch-maildir-notmuch-insert-current-buffer) signals an error
 187     ;; on failure, so to get to this point it must have
 188     ;; succeeded. Also, notmuch-draft-id is still the id of the
 189     ;; previous draft, so it is safe to mark it deleted.
 190     (notmuch-draft--mark-deleted)
 191     (setq notmuch-draft-id (concat "id:" id))
 192     (set-buffer-modified-p nil)))
 193
 194 (defun notmuch-draft-postpone ()
 195   "Save the draft message in the notmuch database and exit buffer."
 196   (interactive)
 197   (notmuch-draft-save)
 198   (kill-buffer))
 199
 200 (add-hook 'message-send-hook 'notmuch-draft--mark-deleted)
 201
 202
 203 (provide 'notmuch-draft)
 204
 205 ;;; notmuch-draft.el ends here