summaryrefslogtreecommitdiffhomepage
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/net/consult-notmuch.el126
1 files changed, 126 insertions, 0 deletions
diff --git a/lib/net/consult-notmuch.el b/lib/net/consult-notmuch.el
new file mode 100644
index 0000000..dab90f8
--- /dev/null
+++ b/lib/net/consult-notmuch.el
@@ -0,0 +1,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