[PATCH v2 2/2] emacs: postpone/resume support

Mark Walters markwalters1009 at gmail.com
Thu Nov 3 11:09:08 PDT 2016


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).
---
 emacs/notmuch-message.el | 187 +++++++++++++++++++++++++++++++++++++++++++++++
 emacs/notmuch-mua.el     |   4 +
 emacs/notmuch-show.el    |   9 +++
 emacs/notmuch-tree.el    |   1 +
 4 files changed, 201 insertions(+)

diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el
index 55e4cfe..a503296 100644
--- a/emacs/notmuch-message.el
+++ b/emacs/notmuch-message.el
@@ -24,6 +24,9 @@
 (require 'message)
 (require 'notmuch-tag)
 (require 'notmuch-mua)
+(require 'notmuch-maildir-fcc)
+
+(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 +41,49 @@ 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)
+
+(defcustom notmuch-message-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)
+
+(defvar notmuch-message-draft-id nil
+  "Message-id of the most recent saved draft of this message")
+(make-variable-buffer-local 'notmuch-message-draft-id)
+
 (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,7 +91,148 @@ 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-mark-draft-deleted ()
+  "Tag the last saved draft deleted.
+
+Used when a new version is saved, or the message is sent."
+  (when notmuch-message-draft-id
+    (notmuch-tag notmuch-message-draft-id '("+deleted"))))
+
+(defun notmuch-message-quote-some-mml ()
+  "Quote the mml tags in `notmuch-message-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-message-quoted-tags
+      (let ((re (concat "<#!*/?\\("
+			(mapconcat 'identity notmuch-message-quoted-tags "\\|")
+			"\\)")))
+	(message-goto-body)
+	(while (re-search-forward re nil t)
+	  ;; Insert ! after the #.
+	  (goto-char (+ (match-beginning 0) 2))
+	  (insert "!"))))))
+
+(defun notmuch-message-unquote-some-mml ()
+  "Unquote the mml tags in `notmuch-message-quoted-tags`."
+  (save-excursion
+    (when notmuch-message-quoted-tags
+      (let ((re (concat "<#!+/?\\("
+			(mapconcat 'identity notmuch-message-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-message-save-draft ()
+  "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)."
+  (interactive)
+  (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-message-quote-some-mml)
+     (notmuch-maildir-setup-message-for-saving)
+     (notmuch-maildir-notmuch-insert-current-buffer
+      notmuch-message-draft-folder 't notmuch-message-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-message-draft-id is still the id of the
+    ;; previous draft, so it is safe to mark it deleted.
+    (notmuch-message-mark-draft-deleted)
+    (setq notmuch-message-draft-id (concat "id:" id))
+    (set-buffer-modified-p nil)))
+
+(defun notmuch-message-postpone ()
+  "Save the draft message in the notmuch database and exit buffer."
+  (interactive)
+  (notmuch-message-save-draft)
+  (kill-buffer))
+
+(defun notmuch-message-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-message-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-message-unquote-some-mml))
+      (notmuch-message-mode)
+      (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-message-draft-id (when draft id)))))
+
+
 (add-hook 'message-send-hook 'notmuch-message-mark-replied)
+(add-hook 'message-send-hook 'notmuch-message-mark-draft-deleted)
 
 (provide 'notmuch-message)
 
diff --git a/emacs/notmuch-mua.el b/emacs/notmuch-mua.el
index f333655..c2fe1ce 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-message-postpone "notmuch-message" ())
+(declare-function notmuch-message-save-draft "notmuch-message" ())
 
 ;;
 
@@ -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-message-postpone)
+(define-key notmuch-message-mode-map (kbd "C-x C-s") #'notmuch-message-save-draft)
 
 (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..d4f5d30 100644
--- a/emacs/notmuch-show.el
+++ b/emacs/notmuch-show.el
@@ -50,6 +50,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-message-resume "notmuch-message" (id))
 
 (defcustom notmuch-message-headers '("Subject" "To" "Cc" "Date")
   "Headers that should be shown in a message, in this order.
@@ -1445,6 +1446,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 +1984,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-message-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 b719b1e..6c93bf9 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -263,6 +263,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.1.4



More information about the notmuch mailing list