blob: dab90f8d691b8388165f002e2dbeb67c58a75222 (
plain)
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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
;;; consult-notmuch.el --- notmuch search using consult -*- lexical-binding: t; -*-
;; Copyright (C) 2021 jao
;; Author: jao <mail@jao.io>
;; Maintainer: jao
;; Keywords: mail
;; License: GPL-3.0-or-later
;; Version: 0.1
;; Package-Requires: ((emacs "26.1") (consult "0.5") (notmuch "0.21"))
;; This implementation is very heavily inspired by Alexander Fu Xi's
;; for counsel: https://github.com/fuxialexander/counsel-notmuch/
;; 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:
;; This package provides two commands using consult to query notmuch
;; emails and present results either as single emails
;; (`consult-notmuch') or full trees (`consult-notmuch-tree').
;;; Code:
(require 'consult)
(require 'notmuch)
(require 's)
(defgroup consult-notmuch nil
"Options for consult-notmuch."
:group 'Notmuch)
(defcustom consult-notmuch-command "notmuch search *ARG*"
"Command to perform notmuch search"
:type 'string
:group 'consult-notmuch)
(defface consult-notmuch-date-face
'((t :inherit notmuch-search-date :background nil))
"Default face used in tree mode face for matching messages"
:group 'consult-notmuch)
(defface consult-notmuch-count-face
'((t :inherit notmuch-search-count :background nil))
"Default face used in tree mode face for matching messages"
:group 'consult-notmuch)
(defface consult-notmuch-people-face
'((t :inherit notmuch-search-matching-authors :background nil))
"Default face used in tree mode face for matching messages"
:group 'consult-notmuch)
(defface consult-notmuch-subject-face
'((t :inherit notmuch-search-subject :background nil))
"Default face used in tree mode face for matching messages"
:group 'consult-notmuch)
(defvar consult-notmuch-history nil
"History for `consult-notmuch'.")
(defun consult-notmuch--tree (thread &optional initial-input)
"Open resulting THREAD in ‘notmuch-tree’ view with INITIAL-INPUT."
(let ((thread-id (car (split-string thread "\\ +"))))
(notmuch-tree thread-id initial-input nil)))
(defun consult-notmuch--show (thread)
"Open resulting THREAD in ‘notmuch-show’ view."
(let ((title (concat "*consult-notmuch-show*" (substring thread 24)))
(thread-id (car (split-string thread "\\ +"))))
(notmuch-show thread-id nil nil nil title)))
(defun consult-notmuch--transformer (str)
"Transform STR to notmuch display style."
(when (string-match "thread:" str)
(let* ((thread-id (car (split-string str "\\ +")))
(date (substring str 24 37))
(mid (substring str 24))
(mat0 (string-match "[[]" mid))
(mat1 (string-match "[]]" mid))
(mat (substring mid mat0 (1+ mat1)))
(people (truncate-string-to-width
(string-trim (nth 1 (split-string mid "[];]"))) 20))
(subject (truncate-string-to-width
(string-trim (nth 1 (split-string mid "[;]")))
(- (frame-width) 32))))
(format "%s %s\t%10s\t%20s\t%s"
(propertize thread-id 'invisible t)
(propertize date 'face 'consult-notmuch-date-face)
(propertize mat 'face 'consult-notmuch-count-face)
(propertize people 'face 'consult-notmuch-people-face)
(propertize subject 'face 'consult-notmuch-subject-face)))))
(defun consult-notmuch--search ()
"Perform an asynchronous notmuch search via consult--read"
(consult--read (consult--async-command consult-notmuch-command
(consult--async-map #'consult-notmuch--transformer))
:prompt "Notmuch search: "
:require-match t
:history 'consult-notmuch-history
:category 'notmuch-result))
;;;###autoload
(defun consult-notmuch ()
"Search for your email in notmuch, showing single messages."
(interactive)
(consult-notmuch--show (consult-notmuch--search)))
;;;###autoload
(defun consult-notmuch-tree ()
"Search for your email in notmuch, showing full candidate tree."
(interactive)
(consult-notmuch--tree (consult-notmuch--search)))
(provide 'consult-notmuch)
;;; consult-notmuch.el ends here
|
