[PATCH v2 3/3] emacs: postpone/resume support
Mark Walters
markwalters1009 at gmail.com
Fri Jun 3 10:49:55 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 | 135 +++++++++++++++++++++++++++++++++++++++++++++++
emacs/notmuch-mua.el | 4 ++
emacs/notmuch-show.el | 13 +++++
emacs/notmuch-tree.el | 1 +
4 files changed, 153 insertions(+)
diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el
index d437b85..0bfb4d3 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,32 @@ 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)
+
+(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 +73,114 @@ 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-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)
+
+ ;; This is based on message-do-fcc but modified for our needs.
+ (let ((case-fold-search t)
+ (buf (current-buffer))
+ (mml-externalize-attachments nil)
+ ;; We generate a message id now as we will need it later. 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-current-buffer (get-buffer-create " *message temp*")
+ (erase-buffer)
+ (insert-buffer-substring buf)
+ ;; 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"))
+
+ ;; Back to following message-do-fcc
+ (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 ))
+
+ (apply 'notmuch-call-notmuch-process :stdin-string (buffer-string)
+ "insert" "--create-folder"
+ (concat "--folder=" notmuch-message-draft-folder)
+ notmuch-message-draft-tags))
+ ;; We are now back in the original compose buffer. Note the
+ ;; function notmuch-call-notmuch-process signals an error on
+ ;; failure, so to get to this point it must have succeeded. Note
+ ;; 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 editting of message with id ID."
+ (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 our added Date and Message-ID headers (unless the user has
+ ;; explicitly customized emacs to tell us not to).
+ (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")))
+ (notmuch-message-mode)
+ (set-buffer-modified-p t)
+ ;; 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 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 399e138..3118e5d 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-fcc-handler "notmuch-maildir-fcc" (destdir))
+(declare-function notmuch-message-postpone "notmuch-message" ())
+(declare-function notmuch-message-save-draft "notmuch-message" ())
;;
@@ -283,6 +285,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 f33096c..998fd27 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-message)
(declare-function notmuch-call-notmuch-process "notmuch" (&rest args))
(declare-function notmuch-search-next-thread "notmuch" nil)
@@ -1425,6 +1426,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 "*" 'notmuch-show-tag-all)
@@ -1955,6 +1957,17 @@ 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.
+
+Resume the current message. Queries if the message does not
+appear to be a draft."
+ (interactive)
+ (let ((tags (notmuch-show-get-tags)))
+ (when (or (equal tags (notmuch-update-tags tags notmuch-message-draft-tags))
+ (yes-or-no-p "Message does not appear to be a draft: really resume?"))
+ (notmuch-message-resume (notmuch-show-get-message-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 6c35543..c759290 100644
--- a/emacs/notmuch-tree.el
+++ b/emacs/notmuch-tree.el
@@ -261,6 +261,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