diff options
| -rw-r--r-- | gnus.org | 83 | ||||
| -rw-r--r-- | lib/doc/jao-org-links.el | 4 | ||||
| -rw-r--r-- | lib/net/jao-notmuch-gnus.el | 147 |
3 files changed, 168 insertions, 66 deletions
@@ -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 |