config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

notmuch-draft.el (10751B)


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