[WIP PATCH] emacs: postpone/resume support

[Mark Walters]

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).
---

This is a WIP patch enabling postpone/resume. On very light testing so
far it seems to work surprisingly well.

Please note that it is an early version, so it may eat your draft
message, mangle (or mysteriously corrupt) your draft message etc; and
it each draft will remain in your message store unless you manually
delete it.

To use: to postpone just do M-x notmuch-message-postpone in your
compose buffer. To resume fo M-x notmuch-message-resume while on the
correct message in a show buffer. You may want to add "draft" to your
exclude tags in .notmuch-config so that drafts only show up if you
search for them explicitly.

CAVEATS:

Attachments work, but the attachment that is sent is the attachment
that was there when the message was postponed. (Attachments added
after resume are obviously not added until the message is sent.)

If the database is locked when you try and postpone it will
mysteriously fail. I think this is actually caused by a bug elsewhere
in notmuch. But in any case the compose buffer should not be killed in
this case.

It would probably be nice to delete the messages on resume. Since we
don't really have that functionality, we just add a deleted tag. This
will hide them in search buffers but, if you postpone a reply, it ill
still show up (collapsed) in the show buffer for the thread.

If you resume a postponed message and then postpone again without
editting then the deleted tag will not be removed so the message may
be hard to find. (see below for possible fixed for this)

Messages don't get a date header as emacs adds that when it sends it
so notmuch will list all postponed message as 1 Jan 1970. 

If you use signing or encryption then I don't know what will happen --
I have not tested at all.  You might sign a partial message that you
didn't mean too; you might expose plain text to someone.

WHAT NEEDS DOING

Trivially we would want some keybindings for the two commands (any
suggested keybindings gratefully received). More significantly, I
would either like a flag to notmuch insert to say "make these tag
changes even if the message already exists"; or perhaps a notmuch
delete command that (genuinely) deletes a single message.

Best wishes

Mark



emacs/notmuch-message.el | 90 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)

diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el
index d437b85..fdd91c0 100644
--- a/emacs/notmuch-message.el
+++ b/emacs/notmuch-message.el
@@ -25,6 +25,8 @@
 (require 'notmuch-tag)
 (require 'notmuch-mua)
 
+(declare-function notmuch-show-get-message-id "notmuch-show" (&optional bare))
+
 (defcustom notmuch-message-replied-tags '("+replied")
   "List of tag changes to apply to a message when it has been replied to.
 
@@ -38,6 +40,28 @@ the \"inbox\" and \"todo\" tags, you would set:
   :type '(repeat string)
   :group 'notmuch-send)
 
+(defcustom notmuch-message-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-send)
+
+(defcustom notmuch-message-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-send)
+
 (defun notmuch-message-mark-replied ()
   ;; get the in-reply-to header and parse it for the message id.
   (let ((rep (mail-header-parse-addresses (message-field-value "In-Reply-To"))))
@@ -45,6 +69,72 @@ the \"inbox\" and \"todo\" tags, you would set:
       (notmuch-tag (notmuch-id-to-query (car (car rep)))
 	       (notmuch-tag-change-list notmuch-message-replied-tags)))))
 
+(defun notmuch-message-postpone ()
+  "Save the current draft message in the notmuch database.
+
+This saves the current message in the database with tags
+`notmuch-message-draft-tags` (in addition to any default tags
+applied to newly inserted messages)."
+  ;; This is taken from message-do-fcc but modified for our needs.  In
+  ;; particular we don't want to process other fcc lines, nor remove
+  ;; them. Note some of the following may not be needed -- I tried to
+  ;; stay close to the original function.
+  (interactive)
+  (let ((case-fold-search t)
+	(buf (current-buffer))
+	(mml-externalize-attachments nil))
+    (with-current-buffer (get-buffer-create " *message temp*")
+      (erase-buffer)
+      (insert-buffer-substring buf)
+      (message-encode-message-body)
+      (save-restriction
+	(message-narrow-to-headers)
+	(let ((mail-parse-charset message-default-charset)
+	      (rfc2047-header-encoding-alist
+	       (cons '("Newsgroups" . default)
+		     rfc2047-header-encoding-alist)))
+	  (mail-encode-encoded-word-buffer)))
+      (goto-char (point-min))
+      (when (re-search-forward
+	     (concat "^" (regexp-quote mail-header-separator) "$")
+	     nil t)
+	(replace-match "" t t ))
+
+      ;; Unless the user has entered a message-id manually the message
+      ;; does not have one -- thus notmuch will use the sha1 of the
+      ;; message. Hence we should only get a collision if the message
+      ;; is identical to a previous draft. In this case we should
+      ;; remove the deleted tag, but it is not clear howto.
+      (apply 'notmuch-call-notmuch-process :stdin-string (buffer-string)
+	     "insert" "--create-folder"
+	     (concat "--folder=" notmuch-message-draft-folder)
+	     notmuch-message-draft-tags)))
+  ;; The function notmuch-call-notmuch-process signals an error on failure, so
+  ;; to get to this point it must have succeeded.
+  (set-buffer-modified-p nil)
+  (kill-buffer))
+
+(defun notmuch-message-resume (&optional id)
+  "View the original source of the current message."
+  (interactive)
+  (let* ((id (or id (notmuch-show-get-message-id)))
+	 (buf (get-buffer-create (concat "*notmuch-draft-" id "*")))
+	 (inhibit-read-only t))
+    (switch-to-buffer buf)
+    (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))
+    (notmuch-message-mode)
+    (set-buffer-modified-p t)
+    ;; Delete the message (since we can't do this yet just tag it deleted).
+    (notmuch-tag id '("+deleted"))))
+
+
 (add-hook 'message-send-hook 'notmuch-message-mark-replied)
 
 (provide 'notmuch-message)
-- 
2.1.4