From: Mark Walters Date: Sat, 4 Jun 2016 00:43:46 +0000 (+0100) Subject: [PATCH v3] emacs: postpone/resume support X-Git-Url: http://git.tremily.us/?a=commitdiff_plain;h=e214227da9bcdaf750639bf0b947dfbd5555c8dc;p=notmuch-archives.git [PATCH v3] emacs: postpone/resume support --- diff --git a/73/b3322d06a86912fe3a75f3ac4b21bd527cd0d8 b/73/b3322d06a86912fe3a75f3ac4b21bd527cd0d8 new file mode 100644 index 000000000..100309c61 --- /dev/null +++ b/73/b3322d06a86912fe3a75f3ac4b21bd527cd0d8 @@ -0,0 +1,413 @@ +Return-Path: +X-Original-To: notmuch@notmuchmail.org +Delivered-To: notmuch@notmuchmail.org +Received: from localhost (localhost [127.0.0.1]) + by arlo.cworth.org (Postfix) with ESMTP id 8E3B36DE0243 + for ; Fri, 3 Jun 2016 17:44:00 -0700 (PDT) +X-Virus-Scanned: Debian amavisd-new at cworth.org +X-Spam-Flag: NO +X-Spam-Score: 0.171 +X-Spam-Level: +X-Spam-Status: No, score=0.171 tagged_above=-999 required=5 tests=[AWL=-0.259, + DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, + FREEMAIL_ENVFROM_END_DIGIT=0.25, FREEMAIL_FROM=0.001, FREEMAIL_REPLY=1, + RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_MSPIKE_H3=-0.01, RCVD_IN_MSPIKE_WL=-0.01, + SPF_PASS=-0.001] autolearn=disabled +Received: from arlo.cworth.org ([127.0.0.1]) + by localhost (arlo.cworth.org [127.0.0.1]) (amavisd-new, port 10024) + with ESMTP id WBziaDPHjiNj for ; + Fri, 3 Jun 2016 17:43:52 -0700 (PDT) +Received: from mail-wm0-f66.google.com (mail-wm0-f66.google.com + [74.125.82.66]) by arlo.cworth.org (Postfix) with ESMTPS id 0509D6DE0159 for + ; Fri, 3 Jun 2016 17:43:52 -0700 (PDT) +Received: by mail-wm0-f66.google.com with SMTP id e3so2725829wme.2 + for ; Fri, 03 Jun 2016 17:43:51 -0700 (PDT) +DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; + h=from:to:cc:subject:date:message-id; + bh=fOHO2wjwDJ9yaRpIdpA4cNWj9fDAyYMhINLHTSMJwEg=; + b=SCRGHj4lcmaRtupkl9iBTvM0IsVms5RyuoA/fnY9Bp4rQWqgNdUpFT7vevFNk9mrQn + zxTiB+b+bhIwZrCwvKr+6wHLprlWcBorN7dIobwYyuXhC0ccPWEXSSX8egfhg0Rnc9dx + yVPNW3AZSOGJs1+1CWvjoNkkktl89UpLUQyjHRISTUR0WTOv9OdWGIk98XTGgnZikKWO + sQAqrvIGDGpBFAbyPqizTznE48lmGIk4DmqKxabbqgQ7dLH0wRKgRAr5qaifpOwiRK+l + DrSY8i0bHt5nVoJQ6uuRkrEgA2/C8PFcRjum4j1hymycnYBbrCDJPKXCzy+D/W+6aC6v + J4+A== +X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; + d=1e100.net; s=20130820; + h=x-gm-message-state:from:to:cc:subject:date:message-id; + bh=fOHO2wjwDJ9yaRpIdpA4cNWj9fDAyYMhINLHTSMJwEg=; + b=Gb/jJlXV7Ez9RkFTse1jWP149Oy0e0XB18VfK796TYj+hbTTfVrTnF3OQpuLxNo2xc + P6Kg+UBJ4MMc91HcmxWYlyY3wCpvFmuni9z/wjbpUDrAO0Dgjuy7kw48pOU6IBZMDRdG + FgrAOBbhnNjcLhCz10OqyA1BxuI48xF6UO9OHdVYmDK2cxUpdLsnUYjIOXM/shcS+d7p + sNOJ7SFF9hdSX9o0vghEqkgNVClX8j10LvcpKwNfUccNITf/WibusyoP9e5HfKu6khia + 3Antyx2Il2ZHOkF5B7SpByeYS12nUBp593IRzU7xrWa0/NUCL233UoHXaJrXYP/0w/RX + w4bw== +X-Gm-Message-State: + ALyK8tIs1ZWPEs3vI3wrB+Qerobi+ng3KAQIs9CPqHAe35+ZqcKWPJd3D5KRdQ9LvSCiYQ== +X-Received: by 10.194.184.169 with SMTP id ev9mr5528316wjc.27.1465001030025; + Fri, 03 Jun 2016 17:43:50 -0700 (PDT) +Received: from localhost (5751dfa2.skybroadband.com. [87.81.223.162]) + by smtp.gmail.com with ESMTPSA id db6sm8105538wjb.2.2016.06.03.17.43.48 + (version=TLS1_2 cipher=ECDHE-RSA-AES128-GCM-SHA256 bits=128/128); + Fri, 03 Jun 2016 17:43:49 -0700 (PDT) +From: Mark Walters +To: notmuch@notmuchmail.org +Subject: [PATCH v3] emacs: postpone/resume support +Date: Sat, 4 Jun 2016 01:43:46 +0100 +Message-Id: <1465001026-29392-1-git-send-email-markwalters1009@gmail.com> +X-Mailer: git-send-email 2.1.4 +X-BeenThere: notmuch@notmuchmail.org +X-Mailman-Version: 2.1.20 +Precedence: list +List-Id: "Use and development of the notmuch mail system." + +List-Unsubscribe: , + +List-Archive: +List-Post: +List-Help: +List-Subscribe: , + +X-List-Received-Date: Sat, 04 Jun 2016 00:44:00 -0000 + +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). +--- + +Sorry to be rather spamming the list. This is another version of the +postpone/resume series. This replaces the third patch in the series at +id:1464976195-23134-1-git-send-email-markwalters1009@gmail.com (so +should be applied on top of the first two). + +There are three main changes -- + +1) It seems that editing an already sent message does work -- as it is +not heavily tested we warn before doing it. But now when you send the +new version it does not tag the old version as deleted (we only tag +drafts deleted). + +2) We quote secure mml tags before saving. This avoids problems with +signing the wrong message, stale signatures, and using the wrong keys +for encryption. Note the draft message will be stored in the mail +store unencrypted. + +3) You can choose to quote more mml tags than just secure; there is a +custom variable notmuch-message-quoted-tags under notmuch-send which +should be a list of tags to quote. If you set it to '("secure" "part") +then attachments won't be saved with the draft. This may be desired in +some cases (but may break things like postponing rfc822 forwarded +messages). Anyway the option is there for anyone who wants to test! + +Best wishes + +Mark + + + + +emacs/notmuch-message.el | 190 +++++++++++++++++++++++++++++++++++++++++++++++ + emacs/notmuch-mua.el | 4 + + emacs/notmuch-show.el | 9 +++ + emacs/notmuch-tree.el | 1 + + 4 files changed, 204 insertions(+) + +diff --git a/emacs/notmuch-message.el b/emacs/notmuch-message.el +index d437b85..6a137b5 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,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 '("secure") ++ "Mml tags to quote. ++ ++This should be a list of mml tags to quote before saving. It is ++recommended that the list includes \"secure\". ++ ++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 +90,152 @@ 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`." ++ ;; This is copied from mml-quote-region but only quotes the ++ ;; specified tags. ++ (when notmuch-message-quoted-tags ++ (save-excursion ++ (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`." ++ (when notmuch-message-quoted-tags ++ (save-excursion ++ (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)))))) ++ ++(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")) ++ (notmuch-message-quote-some-mml) ++ ;; 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 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 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"))) ++ ;; If the message does not appear to be a draft, the postpone ++ ;; code probably didn't write it, so it should not be unquoted. ++ (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 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..12b21c9 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,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 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 +