1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
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
|