* [autocrypt RFC PATCH] Add support for the notmuch mua
@ 2021-01-10 14:30 David Edmondson
0 siblings, 0 replies; only message in thread
From: David Edmondson @ 2021-01-10 14:30 UTC (permalink / raw)
To: notmuch; +Cc: David Edmondson
---
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
^ permalink raw reply related [flat|nested] only message in thread
only message in thread, other threads:[~2021-01-10 14:30 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-01-10 14:30 [autocrypt RFC PATCH] Add support for the notmuch mua David Edmondson
Code repositories for project(s) associated with this public inbox
https://yhetil.org/notmuch.git/
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).