--- This is very much an RFC patch, as I'm new to autocrypt. It's also a patch for autocrypt (https://git.sr.ht/~zge/autocrypt) rather than notmuch, but it made more sense to send it here first, I think. Comments welcomed. autocrypt-notmuch.el | 103 +++++++++++++++++++++++++++++++++++++++++++ autocrypt.el | 11 +++++ 2 files changed, 114 insertions(+) create mode 100644 autocrypt-notmuch.el diff --git a/autocrypt-notmuch.el b/autocrypt-notmuch.el new file mode 100644 index 0000000..f365be2 --- /dev/null +++ b/autocrypt-notmuch.el @@ -0,0 +1,103 @@ +;;; autocrypt-notmuch.el --- Autocrypt for Notmuch -*- lexical-binding:t -*- + +;; Author: David Edmondson <dme@dme.org> +;; Version: 0.4.0 +;; Keywords: comm +;; Package-Requires: ((emacs "25.1")) +;; URL: https://git.sr.ht/~zge/autocrypt + +;; This file is NOT part of Emacs. +;; +;; This file is in the public domain, to the extent possible under law, +;; published under the CC0 1.0 Universal license. +;; +;; For a full copy of the CC0 license see +;; https://creativecommons.org/publicdomain/zero/1.0/legalcode + +;;; Commentary: + +;; MUA specific functions for Notmuch +;; +;; Set up with: +;; (autocrypt-notmuch-install) + +;;; Code: + +(eval-when-compile + (require 'pcase)) + +(require 'notmuch-show) + +(defvar autocrypt-notmuch-headers-id nil) +(defvar autocrypt-notmuch-headers-cache nil) + +;;;###autoload +(defun autocrypt-notmuch-install () + "Install autocrypt hooks for Notmuch." + (add-hook 'notmuch-show-insert-msg-hook #'autocrypt-process-header)) + +(defun autocrypt-notmuch-uninstall () + "Remove autocrypt hooks for Notmuch." + (remove-hook 'notmuch-show-insert-msg-hook #'autocrypt-process-header) + + (when (and (bufferp autocrypt-notmuch-headers-cache) + (buffer-live-p autocrypt-notmuch-headers-cache)) + (kill-buffer autocrypt-notmuch-headers-cache))) + +(defun autocrypt-notmuch-header-1 (field) + "Return the FIELD header for the currently shown message." + + ;; Currently it is can be expensive to retrieve FIELD if the message + ;; is large, as this function examines a raw copy of the complete + ;; message in a buffer. Given that autocrypt will require several + ;; headers from each message and therefore make repeated calls to + ;; `autocrypt-notmuch-header', attempt to alleviate this cost using + ;; a single element cache containing the headers of any requested + ;; message. + + ;; This would be improved if: + ;; notmuch show --format=raw --body=false + ;; worked. + + (let ((id (notmuch-show-get-message-id t))) + ;; If the current header cache is not for this message, make it + ;; so. + (unless (and (string= id autocrypt-notmuch-headers-id) + (bufferp autocrypt-notmuch-headers-cache) + (buffer-live-p autocrypt-notmuch-headers-cache)) + (setq autocrypt-notmuch-headers-id id + autocrypt-notmuch-headers-cache (get-buffer-create "*autocrypt-notmuch-headers-cache*")) + + (with-current-notmuch-show-message + ;; Keep only the headers in the cache - the body is not + ;; required. + (mail-narrow-to-head) + + (let ((content (buffer-substring (point-min) (point-max)))) + (with-current-buffer autocrypt-notmuch-headers-cache + (erase-buffer) + (insert content)))))) + + (with-current-buffer autocrypt-notmuch-headers-cache + (mail-fetch-field field))) + +(defun autocrypt-notmuch-header (field) + "Ask Notmuch to return header FIELD for the current message." + + (pcase field + ;; Some headers are cached in the message properties - retrieving + ;; them is faster than extracting the raw message and parsing it. + ("Cc" (notmuch-show-get-date)) + ("Date" (notmuch-show-get-date)) + ("From" (notmuch-show-get-from)) + ("To" (notmuch-show-get-date)) + (_ + ;; If this is not a matching message, don't bother looking more + ;; deeply, given that `autocrypt-notmuch-headers-1' can be + ;; expensive for large messages. + (when (plist-get (notmuch-show-get-message-properties) :match) + (autocrypt-notmuch-header-1 field))))) + +(provide 'autocrypt-notmuch) + +;;; autocrypt-notmuch.el ends here diff --git a/autocrypt.el b/autocrypt.el index 965f661..01c36c1 100644 --- a/autocrypt.el +++ b/autocrypt.el @@ -115,6 +115,15 @@ Every member of this list has to be an instance of the :sign-encrypt autocrypt-message-sign-encrypt :secure-attach autocrypt-message-secure-attach :encrypted-p mml-secure-is-encrypted-p) + (notmuch + :install autocrypt-notmuch-install + :uninstall autocrypt-notmuch-uninstall + :header autocrypt-notmuch-header + :add-header autocrypt-message-add-header + :remove-header message-remove-header + :sign-encrypt autocrypt-message-sign-encrypt + :secure-attach autocrypt-message-secure-attach + :encrypted-p mml-secure-is-encrypted-p) (message :install autocrypt-message-install :uninstall autocrypt-message-uninstall @@ -154,6 +163,8 @@ the part contents can be found.") The key should identify a record in the `autocrypt-mua-func-alist' alist." (cond + ((derived-mode-p 'notmuch-show-mode) + 'notmuch) ((derived-mode-p 'mu4e-main-mode 'mu4e-view-mode) 'mu4e) ((derived-mode-p 'gnus-mode) -- 2.29.2