[Patch v3 2/2] emacs: postpone/resume support

[Mark Walters]

On Sun, 06 Nov 2016, David Bremner <david at tethera.net> wrote:
> From: Mark Walters <markwalters1009 at gmail.com>
>
> This provides preliminary support for postponing and resuming in the
> emacs frontend. On postponing it uses notmuch insert to put the
> message in the notmuch database; resume gets the raw file from notmuch
> and using the emacs function mime-to-mml reconstructs the message
> (including attachments).
>
> Current bindings are C-x C-s to save a draft, C-c C-p to postpone a
> draft (save and exit compose buffer), and e to resume a draft from
> show or tree mode.
>
> Previous drafts get tagged deleted on subsequent saves, or on the
> message being sent.
>
> Each draft gets its own message-id, and we use the namespace
> draft-.... for draft message ids (so, at least for most people, drafts
> are easily distinguisable).

Hi

Many thanks for doing this; I definitely like the move to a
notmuch-draft file. I haven't checked it completely yet, or tested it,
but I think the move itself looks fine except for two documentation bits
which aren't quite right -- see below.

Best wishes

Mark



> ---
>  emacs/notmuch-draft.el | 261 +++++++++++++++++++++++++++++++++++++++++++++++++
>  emacs/notmuch-mua.el   |   4 +
>  emacs/notmuch-show.el  |  10 ++
>  emacs/notmuch-tree.el  |   1 +
>  4 files changed, 276 insertions(+)
>  create mode 100644 emacs/notmuch-draft.el
>
> diff --git a/emacs/notmuch-draft.el b/emacs/notmuch-draft.el
> new file mode 100644
> index 0000000..806c1a7
> --- /dev/null
> +++ b/emacs/notmuch-draft.el
> @@ -0,0 +1,261 @@
> +;;; notmuch-draft.el --- functions for postponing and editing drafts
> +;;
> +;; Copyright © Mark Walters
> +;; Copyright © David Bremner
> +;;
> +;; 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 at gmail.com>
> +;;	    David Bremner <david at tethera.net>
> +
> +;;; Code:
> +
> +(require 'notmuch-maildir-fcc)
> +
> +(declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
> +
> +(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
> +  "Should notmuch save/postpone in plaintext messages that seem
> +  like they are intended to be sent encrypted
> +(i.e with an mml encryption tag in it)."
> +  :type '(radio
> +	  (const :tag "Never" nil)
> +	  (const :tag "Ask every time" ask)
> +	  (const :tag "Always" t))
> +  :group 'notmuch-draft
> +  :group 'notmuch-crypto)
> +
> +(defvar notmuch-draft-encryption-tag-regex
> +  "<#\\(part encrypt\\|secure.*mode=.*encrypt>\\)"
> +  "Regular expression matching mml tags indicating encryption of part or message")
> +
> +(defvar notmuch-draft-id nil
> +  "Message-id of the most recent saved draft of this message")
> +(make-variable-buffer-local 'notmuch-draft-id)
> +
> +(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 'identity 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 'identity 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--check-encryption-tag ()
> +  "Query user if there an mml tag that looks like it might indicate encryption.
> +
> +Returns t if there is no such tag, or the user confirms they mean
> +it."
> +  (save-excursion
> +    (message-goto-body)
> +      (or
> +       ;; We are fine if no relevant tag is found, or
> +       (not (re-search-forward notmuch-draft-encryption-tag-regex nil 't))
> +       ;; The user confirms they means it.
> +       (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? "))))
> +
> +(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-draft-tags` (in addition to any default tags
            ^^^^ should just be notmuch-draft-tags

> +applied to newly inserted messages)."
> +  (interactive)
> +  (case notmuch-draft-save-plaintext
> +    ((ask)
> +     (unless (notmuch-draft--check-encryption-tag)
> +       (error "Save aborted")))
> +    ((t)
> +     (ignore))
> +    ((nil)
> +     (error "Refusing to save draft with encryption tags (see `notmuch-draft-save-plaintext')")))
> +  (let (;; We need the message id as we need it for tagging. Note
> +	;; message-make-message-id gives the id inside a "<" ">" pair,
> +	;; but notmuch doesn't want that form, so remove them.
> +	(id (concat "draft-" (substring (message-make-message-id) 1 -1))))
> +    (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.
> +     (if (member 'Message-ID message-deletable-headers)
> +	 (progn
> +	   (message-remove-header "Message-ID")
> +	   (message-add-header (concat "Message-ID: <" id ">")))
> +       (message "You have customized emacs so Message-ID is not a deletable header, so not changing it")
> +       (setq id nil))
> +     (if (member 'Date message-deletable-headers)
> +	 (progn
> +	   (message-remove-header "Date")
> +	   (message-add-header (concat "Date: " (message-make-date))))
> +       (message "You have customized emacs so Date is not a deletable 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-draft-id is still the id of the
                           ^^^^^ should just be notmuch-draft-id

> +    ;; 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-draft)
> +  (kill-buffer))
> +
> +(defun notmuch-draft-resume (id)
> +  "Resume editing of message with id ID."
> +  (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: really resume? "))
> +      (switch-to-buffer (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"))
> +	;; 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 (when draft id)))))
> +
> +
> +(add-hook 'message-send-hook 'notmuch-draft-mark-draft-deleted)
> +
> +
> +(provide 'notmuch-draft)
> +
> +;;; notmuch-draft.el ends here
> diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
> index f333655..b68cdf2 100644
> --- a/emacs/notmuch-mua.el
> +++ b/emacs/notmuch-mua.el
> @@ -33,6 +33,8 @@
>  (declare-function notmuch-show-insert-body "notmuch-show" (msg body depth))
>  (declare-function notmuch-fcc-header-setup "notmuch-maildir-fcc" ())
>  (declare-function notmuch-maildir-message-do-fcc "notmuch-maildir-fcc" ())
> +(declare-function notmuch-draft-postpone "notmuch-draft" ())
> +(declare-function notmuch-draft-save "notmuch-draft" ())
>  
>  ;;
>  
> @@ -289,6 +291,8 @@ mutiple parts get a header."
>  
>  (define-key notmuch-message-mode-map (kbd "C-c C-c") #'notmuch-mua-send-and-exit)
>  (define-key notmuch-message-mode-map (kbd "C-c C-s") #'notmuch-mua-send)
> +(define-key notmuch-message-mode-map (kbd "C-c C-p") #'notmuch-draft-postpone)
> +(define-key notmuch-message-mode-map (kbd "C-x C-s") #'notmuch-draft-save)
>  
>  (defun notmuch-mua-pop-to-buffer (name switch-function)
>    "Pop to buffer NAME, and warn if it already exists and is
> diff --git a/emacs/notmuch-show.el b/emacs/notmuch-show.el
> index fcf7e6e..79e4435 100644
> --- a/emacs/notmuch-show.el
> +++ b/emacs/notmuch-show.el
> @@ -38,6 +38,7 @@
>  (require 'notmuch-mua)
>  (require 'notmuch-crypto)
>  (require 'notmuch-print)
> +(require 'notmuch-draft)
>  
>  (declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
>  (declare-function notmuch-search-next-thread "notmuch" nil)
> @@ -50,6 +51,7 @@
>  		  (&optional query query-context target buffer-name open-target))
>  (declare-function notmuch-tree-get-message-properties "notmuch-tree" nil)
>  (declare-function notmuch-read-query "notmuch" (prompt))
> +(declare-function notmuch-draft-resume "notmuch-draft" (id))
>  
>  (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
>    "Headers that should be shown in a message, in this order.
> @@ -1445,6 +1447,7 @@ reset based on the original query."
>      (define-key map "|" 'notmuch-show-pipe-message)
>      (define-key map "w" 'notmuch-show-save-attachments)
>      (define-key map "V" 'notmuch-show-view-raw-message)
> +    (define-key map "e" 'notmuch-show-resume-message)
>      (define-key map "c" 'notmuch-show-stash-map)
>      (define-key map "h" 'notmuch-show-toggle-visibility-headers)
>      (define-key map "k" 'notmuch-tag-jump)
> @@ -1982,6 +1985,13 @@ to show, nil otherwise."
>      (setq buffer-read-only t)
>      (view-buffer buf 'kill-buffer-if-not-modified)))
>  
> +(defun notmuch-show-resume-message ()
> +  "Resume EDITING the current draft message."
> +  (interactive)
> +  (let ((id (notmuch-show-get-message-id)))
> +    (when id
> +      (notmuch-draft-resume id))))
> +
>  (put 'notmuch-show-pipe-message 'notmuch-doc
>       "Pipe the contents of the current message to a command.")
>  (put 'notmuch-show-pipe-message 'notmuch-prefix-doc
> diff --git a/emacs/notmuch-tree.el b/emacs/notmuch-tree.el
> index 8398eb1..4abcf60 100644
> --- a/emacs/notmuch-tree.el
> +++ b/emacs/notmuch-tree.el
> @@ -273,6 +273,7 @@ FUNC."
>      (define-key map "r" (notmuch-tree-close-message-pane-and #'notmuch-show-reply-sender))
>      (define-key map "R" (notmuch-tree-close-message-pane-and #'notmuch-show-reply))
>      (define-key map "V" (notmuch-tree-close-message-pane-and #'notmuch-show-view-raw-message))
> +    (define-key map "e" (notmuch-tree-close-message-pane-and #'notmuch-show-resume-message))
>  
>      ;; The main tree view bindings
>      (define-key map (kbd "RET") 'notmuch-tree-show-message)
> -- 
> 2.10.1