autocrypt.el: Add MUA support for notmuch v2 PROPOSED

Sandra Snan: 1
 Add MUA support for notmuch

 3 files changed, 101 insertions(+), 1 deletions(-)

[PATCH autocrypt.el v2] Add MUA support for notmuch Export this patch

---
 README.md            |  1 +
 autocrypt-notmuch.el | 93 ++++++++++++++++++++++++++++++++++++++++++++
 autocrypt.el         |  8 +++-
 3 files changed, 101 insertions(+), 1 deletion(-)
 create mode 100644 autocrypt-notmuch.el

diff --git a/README.md b/README.md
index b1af7e6..b2fa3eb 100644
--- a/README.md
+++ b/README.md
@@ -10,6 +10,7 @@ Currently, it supports:
 - Rmail, as a viewer
 - Gnus, as a viewer
 - mu4e, as a viewer
+- notmuch, as a viewer
 - message, as a composer
 
 As of writing, this package doesn't fully implement the autocrypt
diff --git a/autocrypt-notmuch.el b/autocrypt-notmuch.el
new file mode 100644
index 0000000..54f47a2
--- /dev/null
+++ b/autocrypt-notmuch.el
@@ -0,0 +1,93 @@
+;; Copyright (C) 2020-2023  Free Software Foundation, Inc.
+
+;;; autocrypt-notmuch.el --- Autocrypt for notmuch -*- lexical-binding:nil -*-
+
+;; Author: Idiomdrottning <sandra.snan@idiomdrottning.org>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; MUA specific functions for notmuch
+
+;; Setup example:
+
+;; (add-hook 'message-mode-hook #'autocrypt-mode)
+;; (add-hook 'notmuch-show-hook #'autocrypt-mode)
+;; (add-hook 'notmuch-search-hook #'autocrypt-mode)
+;; (add-hook 'notmuch-tree-hook #'autocrypt-mode)
+
+;;; Code:
+
+(require 'autocrypt)
+(require 'notmuch)
+
+(defvar autocrypt-notmuch-message-id nil
+  "Parameter to hold various message IDs for
+`autocrypt-process-header'. Requires dynamic binding, not
+lexical.")
+
+(defun autocrypt-notmuch-search-rep-adv (&rest r)
+  (let* ((thread-id (notmuch-search-find-thread-id))
+         (autocrypt-notmuch-message-id
+          (with-temp-buffer ;; Temp buffers reduce flickering when
+                            ;; shelling out to the notmuch binary.
+            (plist-get
+             (plist-get (notmuch-call-notmuch-sexp "reply" "--format=sexp" thread-id) :original)
+             :id))))
+    (when autocrypt-notmuch-message-id
+      (autocrypt-process-header))))
+
+(defun autocrypt-notmuch-tree-rep-adv (&rest r)
+  (let ((autocrypt-notmuch-message-id (notmuch-tree-get-message-id)))
+    (autocrypt-process-header)))
+
+(defun autocrypt-notmuch-show-rep-adv (&rest r)
+  (let ((autocrypt-notmuch-message-id (notmuch-show-get-message-id)))
+    (autocrypt-process-header)))
+
+(defun autocrypt-notmuch-process-sexp-original (original)
+  (let ((autocrypt-notmuch-message-id (plist-get original :id)))
+    (autocrypt-process-header)))
+
+;;;###autocrypt
+(defun autocrypt-notmuch--install ()
+  "Install autocrypt hooks for notmuch."
+  (if (boundp 'notmuch-mua-reply-functions)
+      (add-hook 'notmuch-mua-reply-functions #'autocrypt-notmuch-process-sexp-original)
+    (progn
+      (advice-add 'notmuch-search-reply-to-thread-sender :before #'autocrypt-notmuch-search-rep-adv)
+      (advice-add 'notmuch-tree-reply-sender :before #'autocrypt-notmuch-tree-rep-adv)
+      (advice-add 'notmuch-show-reply :before #'autocrypt-notmuch-show-rep-adv))))
+
+(defun autocrypt-notmuch--uninstall ()
+  "Remove autocrypt hooks for notmuch."
+  (remove-hook 'notmuch-mua-reply-functions #'autocrypt-notmuch-process-sexp-original)
+  (advice-remove 'notmuch-search-reply-to-thread-sender #'autocrypt-notmuch-search-rep-adv)
+  (advice-remove 'notmuch-tree-reply-sender #'autocrypt-notmuch-tree-rep-adv)
+  (advice-remove 'notmuch-show-reply #'autocrypt-notmuch-show-rep-adv))
+
+(defun autocrypt-notmuch--get-header (header)
+  "Ask notmuch to return `header'."
+  (with-temp-buffer ;; Temp buffers reduce flickering when shelling
+                    ;; out to the notmuch binary.
+    (let ((coding-system-for-read 'no-conversion))
+      (call-process notmuch-command
+                    nil t nil "show" "--format=raw" "--body=false"
+                    autocrypt-notmuch-message-id))
+    (mail-fetch-field header)))
+
+(provide 'autocrypt-notmuch)
+
+;;; autocrypt-notmuch.el ends here
diff --git a/autocrypt.el b/autocrypt.el
index d03c86b..686867f 100644
--- a/autocrypt.el
+++ b/autocrypt.el
@@ -116,7 +116,13 @@ Every member of this list has to be an instance of the
 ;;;; Mua Translation Layer
 
 (defvar autocrypt-backends
-  (list (lambda () (and (derived-mode-p 'mu4e-main-mode 'mu4e-view-mode) 'mu4e))
+  (list (lambda () (and '(derived-mode-p mu4e-main-mode)
+                        '(derived-mode-p mu4e-view-mode)
+                        'mu4e))
+        (lambda () (and (derived-mode-p 'notmuch-show-mode)
+                        (derived-mode-p 'notmuch-search-mode)
+                        (derived-mode-p 'notmuch-tree-mode)
+                        'notmuch))
         (lambda () (and (derived-mode-p 'gnus-mode) 'gnus))
         (lambda () (and (derived-mode-p 'rmail-mode) 'rmail))
         (lambda () (and (derived-mode-p 'message-mode) 'message))
-- 
2.39.2