summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-03-02 03:30:55 +0000
committerjao <jao@gnu.org>2022-03-02 03:30:55 +0000
commit4ad52a17ba5bdf9b695c476ec55584cfd7941dbb (patch)
treeef104dc8c728dc60b4fe98efc63c73f5f091c076
parent8b8b40fe1ed9485b5bba72c584ab9b5507b9b65c (diff)
downloadelibs-4ad52a17ba5bdf9b695c476ec55584cfd7941dbb.tar.gz
elibs-4ad52a17ba5bdf9b695c476ec55584cfd7941dbb.tar.bz2
jao-notmuch-gnus: new library for notmuch-gnus interop
-rw-r--r--gnus.org83
-rw-r--r--lib/doc/jao-org-links.el4
-rw-r--r--lib/net/jao-notmuch-gnus.el147
3 files changed, 168 insertions, 66 deletions
diff --git a/gnus.org b/gnus.org
index afd7110..1a5a9ea 100644
--- a/gnus.org
+++ b/gnus.org
@@ -380,82 +380,37 @@
* Notmuch integration
*** notmuch tags
#+begin_src emacs-lisp
- (defun jao-gnus-message-id ()
- (when (derived-mode-p 'gnus-summary-mode)
- (save-window-excursion (gnus-summary-show-article)))
- (when gnus-original-article-buffer
- (with-current-buffer gnus-original-article-buffer
- (when-let (id (message-field-value "message-id"))
- (if (string-match "<\\(.+\\)>" id)
- (match-string 1 id)
- id)))))
-
- (defun jao-gnus-message-tags (id)
- (let ((cmd (format "notmuch search --output=tags 'id:%s'" id)))
- (split-string (shell-command-to-string cmd))))
-
- (defun jao-gnus-tag-message ()
- (interactive)
- (let* ((id (jao-gnus-message-id))
- (current (jao-gnus-message-tags id))
- (prompt (format "Change tags %s" (string-join current "/")))
- (tags (notmuch-read-tag-changes current prompt)))
- (notmuch-tag (concat "id:" id) tags)
- (message "%s -> %s" current (jao-gnus-message-tags id))))
-
- (defun jao-gnus-show-tags ()
- (interactive)
- (when-let (id (jao-gnus-message-id))
- (message "%s" (string-join (jao-gnus-message-tags id) " "))))
-
- (defun jao-gnus-toggle-tags (tags)
- (let* ((id (jao-gnus-message-id))
- (current (jao-gnus-message-tags id))
- (tags (mapcar (lambda (x)
- (concat (if (member x current) "-" "+") x))
- tags)))
- (notmuch-tag (concat "id:" id) tags)
- (message "New tags: %s" (jao-gnus-message-tags id))))
+ (require 'jao-notmuch-gnus)
(defun jao-gnus-toggle-todo ()
(interactive)
- (jao-gnus-toggle-tags '("todo")))
+ (jao-notmuch-gnus-toggle-tags '("todo")))
- (define-key gnus-summary-mode-map (kbd "C-c T") #'jao-gnus-tag-message)
- (define-key gnus-summary-mode-map (kbd "C-c t") #'jao-gnus-show-tags)
+ (define-key gnus-summary-mode-map (kbd "C-c T") #'jao-notmuch-gnus-tag-message)
+ (define-key gnus-summary-mode-map (kbd "C-c t") #'jao-notmuch-gnus-show-tags)
(define-key gnus-summary-mode-map (kbd "C-c C-t") #'jao-gnus-toggle-todo)
#+end_src
*** notmuch -> gnus / consult-notmuch
#+begin_src emacs-lisp
- (defun jao-notmuch-goto-message-in-gnus ()
- "Open a summary buffer containing the current notmuch article."
- (interactive)
- (let ((group (jao-maildir-file-to-group (notmuch-show-get-filename)
- mail-source-directory))
- (message-id (replace-regexp-in-string "^id:"
- ""
- (notmuch-show-get-message-id))))
- (if (and group message-id)
- (org-gnus-follow-link group message-id)
- (message "Couldn't get relevant infos for switching to Gnus."))))
-
- (defun jao-gnus-open-consult-candidate (candidate)
- (consult-notmuch--preview candidate nil)
- (with-current-buffer consult-notmuch--buffer-name
- (jao-notmuch-goto-message-in-gnus)
- (save-window-excursion (consult-notmuch--close-preview))))
-
- (defun jao-gnus-consult-notmuch ()
- (interactive)
- (jao-gnus-open-consult-candidate (consult-notmuch--search)))
-
(with-eval-after-load "notmuch-show"
(define-key gnus-group-mode-map "z" #'jao-gnus-consult-notmuch)
(define-key gnus-group-mode-map "Z" #'notmuch)
- (define-key notmuch-show-mode-map (kbd "C-c C-c")
- #'jao-notmuch-goto-message-in-gnus))
- #+end_src
+ (define-key notmuch-show-mode-map
+ (kbd "C-c C-c")
+ #'jao-notmuch-gnus-goto-message))
+
+ (defun jao-gnus-notmuch-export (query)
+ (notmuch-tree query nil nil "* consult-notmuch results *"))
+
+ (setq consult-notmuch-export-function #'jao-gnus-notmuch-export)
+
+ (with-eval-after-load "notmuch-tree"
+ (define-key notmuch-tree-mode-map
+ (kbd "C-<return>")
+ #'jao-notmuch-gnus-goto-message))
+
+ #+end_src
* Groups buffer
#+begin_src emacs-lisp
;; (setq gnus-group-line-format " %m%S%p%P:%~(pad-right 35)c %3y %B\n")
diff --git a/lib/doc/jao-org-links.el b/lib/doc/jao-org-links.el
index dd183e1..60b0037 100644
--- a/lib/doc/jao-org-links.el
+++ b/lib/doc/jao-org-links.el
@@ -4,7 +4,7 @@
(require 'jao-org-notes)
(require 'jao-doc-view)
-(require 'jao-maildir)
+(require 'jao-notmuch-gnus)
(declare pdf-info-outline "pdf-info")
@@ -56,7 +56,7 @@
f))))
(defun jao-org-links-open-mail (fname)
- (let ((group (jao-maildir-file-to-group fname))
+ (let ((group (jao-notmuch-gnus-file-to-group fname))
(id (with-temp-buffer
(insert-file fname)
(goto-char (point-min))
diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el
new file mode 100644
index 0000000..fbfa423
--- /dev/null
+++ b/lib/net/jao-notmuch-gnus.el
@@ -0,0 +1,147 @@
+;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 jao
+
+;; Author: jao <mail@jao.io>
+;; Keywords: mail
+
+;; 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:
+
+;; Helper functions to work in Gnus with mail indexed by notmuch.
+
+;;; Code:
+
+(require 'gnus)
+(require 'notmuch-show)
+
+
+;;; Tagging in notmuch from Gnus buffers
+(defun jao-notmuch-gnus-message-id ()
+ "Find the id currently selected message in Gnus."
+ (when (derived-mode-p 'gnus-summary-mode)
+ (save-window-excursion (gnus-summary-show-article)))
+ (when gnus-original-article-buffer
+ (with-current-buffer gnus-original-article-buffer
+ (when-let (id (message-field-value "message-id"))
+ (if (string-match "<\\(.+\\)>" id)
+ (match-string 1 id)
+ id)))))
+
+(defun jao-notmuch-gnus-message-tags (id)
+ "Ask notmuch for the tags of a message with the given ID."
+ (let ((cmd (format "notmuch search --output=tags 'id:%s'" id)))
+ (split-string (shell-command-to-string cmd))))
+
+(defun jao-notmuch-gnus-tag-message ()
+ "Interactively add or remove tags to the current message."
+ (interactive)
+ (let* ((id (jao-notmuch-gnus-message-id))
+ (current (jao-notmuch-gnus-message-tags id))
+ (prompt (format "Change tags %s" (string-join current "/")))
+ (tags (notmuch-read-tag-changes current prompt)))
+ (notmuch-tag (concat "id:" id) tags)
+ (message "%s -> %s" current (jao-notmuch-gnus-message-tags id))))
+
+(defun jao-notmuch-gnus-show-tags ()
+ "Display in the echo area the tags of the current message."
+ (interactive)
+ (when-let (id (jao-notmuch-gnus-message-id))
+ (message "%s" (string-join (jao-notmuch-gnus-message-tags id) " "))))
+
+(defun jao-notmuch-gnus-toggle-tags (tags)
+ "Toggle the given TAGS list for the current Gnus message."
+ (let* ((id (jao-notmuch-gnus-message-id))
+ (current (jao-notmuch-gnus-message-tags id))
+ (tags (mapcar (lambda (x)
+ (concat (if (member x current) "-" "+") x))
+ tags)))
+ (notmuch-tag (concat "id:" id) tags)
+ (message "New tags: %s" (jao-notmuch-gnus-message-tags id))))
+
+
+
+;;;; Displaying search results in Gnus
+
+(defvar jao-notmuch-gnus-server "nnml"
+ "Name of the target Gnus server, e.g. nnml+mail.")
+
+(defvar jao-notmuch-gnus-mail-directory message-directory
+ "Directory where Gnus stores its mail.")
+
+(defvar jao-notmuch-gnus-leafnode-directory "~/var/news"
+ "Directory where leafnode stores its messages as seen by notmuch.")
+
+(defun jao-notmuch-gnus-file-to-group (file &optional maildir newsdir)
+ "Calculate the Gnus group name from the given file name.
+Example:
+
+ IN: /home/jao/var/mail/jao/foo/cur/1259184569.M4818P3384.localhost,W=6921:2,S
+ OUT: nnml:jao.foo
+
+ IN: /home/jao/.emacs.d/gnus/Mail/jao.trove/32, /home/jao/.emacs.d/gnus/Mail/
+ OUT: nnml:jao.trove
+
+ IN: /home/jao/var/mail/gmane/foo/bar/100
+ OUT: nntp:gmane.foo.bar
+
+ IN: /home/jao/var/mail/bigml/cur/1259176906.M17483P24679.localhost,W=2488:2,S
+ OUT:nnimap:bigml/inbox"
+ (let* ((maildir (or maildir jao-notmuch-gnus-mail-directory))
+ (newsdir (or newsdir jao-notmuch-gnus-leafnode-directory))
+ (g (directory-file-name (file-name-directory file)))
+ (g (replace-regexp-in-string (file-name-as-directory maildir) "" g))
+ (g (replace-regexp-in-string (file-name-as-directory newsdir) "" g))
+ (nntp (string-match-p "^\\(gmane\\|gwene\\)/" g))
+ (g (cond (nntp (concat "nntp:" g))
+ ((file-name-directory g)
+ (replace-regexp-in-string "^\\([^/]+\\)/"
+ (concat jao-notmuch-gnus-server
+ ":\\1/")
+ (file-name-directory g) t))
+ (t (concat jao-notmuch-gnus-server ":" g))))
+ (g (replace-regexp-in-string "/" "." g))
+ (g (replace-regexp-in-string "[/.]$" "" g)))
+ (cond ((string-match ":$" g) (concat g "inbox"))
+ (nntp g)
+ (t (replace-regexp-in-string ":\\." ":" g)))))
+
+(defun jao-notmuch-gnus-goto-message ()
+ "Open a summary buffer containing the current notmuch article."
+ (interactive)
+ (let ((group (jao-notmuch-gnus-file-to-group (notmuch-show-get-filename)
+ jao-notmuch-gnus-mail-directory))
+ (message-id (replace-regexp-in-string "^id:"
+ ""
+ (notmuch-show-get-message-id))))
+ (if (and group message-id)
+ (org-gnus-follow-link group message-id)
+ (message "Couldn't get relevant infos for switching to Gnus."))))
+
+(with-eval-after-load "consult-notmuch"
+ (defun jao-notmuch-gnus--open-candidate (candidate)
+ "Open a notmuch-search completion candidate email in Gnus."
+ (consult-notmuch--preview candidate nil)
+ (with-current-buffer consult-notmuch--buffer-name
+ (jao-notmuch-gnus-goto-message)
+ (save-window-excursion (consult-notmuch--close-preview))))
+
+ (defun jao-gnus-consult-notmuch ()
+ "Run a consult-notmuch query that opens candidates in Gnus."
+ (interactive)
+ (jao-notmuch-gnus--open-candidate (consult-notmuch--search))))
+
+(provide 'jao-notmuch-gnus)
+;;; jao-notmuch-gnus.el ends here