diff options
author | jao <jao@gnu.org> | 2022-03-02 03:30:55 +0000 |
---|---|---|
committer | jao <jao@gnu.org> | 2022-03-02 03:30:55 +0000 |
commit | 4ad52a17ba5bdf9b695c476ec55584cfd7941dbb (patch) | |
tree | ef104dc8c728dc60b4fe98efc63c73f5f091c076 /lib/net/jao-notmuch-gnus.el | |
parent | 8b8b40fe1ed9485b5bba72c584ab9b5507b9b65c (diff) | |
download | elibs-4ad52a17ba5bdf9b695c476ec55584cfd7941dbb.tar.gz elibs-4ad52a17ba5bdf9b695c476ec55584cfd7941dbb.tar.bz2 |
jao-notmuch-gnus: new library for notmuch-gnus interop
Diffstat (limited to 'lib/net/jao-notmuch-gnus.el')
-rw-r--r-- | lib/net/jao-notmuch-gnus.el | 147 |
1 files changed, 147 insertions, 0 deletions
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 |