On Sun, 06 Nov 2016, David Bremner <david@tethera.net> wrote: > From: Mark Walters <markwalters1009@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@gmail.com> > +;; David Bremner <david@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