jao-notmuch-gnus: new library for notmuch-gnus interop

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