From a7c09173974e4f4a1bb94c2eae4de0b47e5eb966 Mon Sep 17 00:00:00 2001 From: jao Date: Tue, 29 Oct 2024 00:41:30 +0000 Subject: gnus/notmuch interaction recovered --- attic/elisp/jao-notmuch-gnus.el | 226 ---------------------------------------- custom/jao-custom-gnus.el | 12 ++- lib/net/jao-notmuch-gnus.el | 226 ++++++++++++++++++++++++++++++++++++++++ 3 files changed, 237 insertions(+), 227 deletions(-) delete mode 100644 attic/elisp/jao-notmuch-gnus.el create mode 100644 lib/net/jao-notmuch-gnus.el diff --git a/attic/elisp/jao-notmuch-gnus.el b/attic/elisp/jao-notmuch-gnus.el deleted file mode 100644 index 1576964..0000000 --- a/attic/elisp/jao-notmuch-gnus.el +++ /dev/null @@ -1,226 +0,0 @@ -;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- - -;; Copyright (C) 2022 jao - -;; Author: jao -;; 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 . - -;;; Commentary: - -;; Helper functions to work in Gnus with mail indexed by notmuch. - -;;; Code: - -(require 'gnus) -(require 'ol-gnus) -(require 'notmuch-show) - -;;; Tagging in notmuch from Gnus buffers - -(defun jao-notmuch-gnus--notmuch-id (id) - (when id (if (string-match "<\\(.+\\)>" id) (match-string 1 id) id))) - -(defun jao-notmuch-gnus-message-id (&optional no-show) - "Find the id of currently selected message in Gnus or notmuch." - (when (and (not no-show) (derived-mode-p 'gnus-summary-mode)) - (save-window-excursion (gnus-summary-show-article))) - (cond (gnus-original-article-buffer - (with-current-buffer gnus-original-article-buffer - (jao-notmuch-gnus--notmuch-id (message-field-value "message-id")))) - ((derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) - (notmuch-show-get-message-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 (&optional id tags no-log) - "Interactively add or remove tags to the current message." - (interactive) - (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (unless tags (jao-notmuch-gnus-message-tags id))) - (prompt (format "Change tags %s" (string-join current "/"))) - (tags (or tags (notmuch-read-tag-changes current prompt)))) - (notmuch-tag (concat "id:" id) tags) - (unless no-log - (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 &optional id current) - "Toggle the given TAGS list for the current Gnus message." - (let* ((id (or id (jao-notmuch-gnus-message-id))) - (current (or 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)))) - -(defun jao-notmuch-gnus-tag-mark () - "Remove the new tag for an article when it's marked as seen by Gnus." - (when-let (id (jao-notmuch-gnus-message-id t)) - (jao-notmuch-gnus-tag-message id '("-new") t))) - -(add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark) - -(defun jao-notmuch-gnus--group-tags (group) - (when (string-match ".+:\\(.+\\)" group) - (split-string (match-string 1 group) "\\."))) - -(defun jao-notmuch-gnus-tag-on-move (op headers from to _d) - (when-let* ((to-tags (when to (jao-notmuch-gnus--group-tags to))) - (id (jao-notmuch-gnus--notmuch-id (mail-header-id headers)))) - (if (eq op 'delete) - (let ((cur (seq-difference (jao-notmuch-gnus--group-tags from) to-tags))) - (jao-notmuch-gnus-toggle-tags (append cur to-tags) id cur)) - (notmuch-tag (concat "id:" id) - (mapcar (lambda (x) (concat "+" x)) to-tags))))) - -(defun jao-notmuch-gnus-auto-tag () - (add-hook 'gnus-summary-article-move-hook #'jao-notmuch-gnus-tag-on-move) - (add-hook 'gnus-summary-article-expire-hook #'jao-notmuch-gnus-tag-on-move)) - -;;; Gnus search using notmuch - -(add-to-list 'gnus-search-expandable-keys "list") - -(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) - (expr (head list))) - (format "List:%s" (gnus-search-transform-expression engine (cdr expr)))) - - -;;; 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 (expand-file-name "~/.emacs.d/gnus/Mail") - "Directory where Gnus stores its mail.") - -(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/news") - "Directory where leafnode stores its messages as seen by notmuch.") - -(defun jao-notmuch-gnus-file-to-group (file &optional maildir newsdir) - "Compute 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-id-to-file (id) - (when id - (let ((cmd (format "notmuch search --output=files %s" id))) - (string-trim (shell-command-to-string cmd))))) - -(defun jao-notmuch-gnus-goto-message (&optional msg-id filename) - "Open a summary buffer containing the current notmuch article." - (interactive) - (let* ((filename (or filename - (jao-notmuch-gnus-id-to-file msg-id) - (notmuch-show-get-filename))) - (group (when filename (jao-notmuch-gnus-file-to-group filename))) - (msg-id (or msg-id (notmuch-show-get-message-id))) - (msg-id (when msg-id (replace-regexp-in-string "^id:" "" msg-id)))) - (if (and group msg-id) - (org-gnus-follow-link group msg-id) - (message "Couldn't get relevant infos for switching to Gnus.")))) - -(defun jao-notmuch-gnus-engine (prefix config) - (let ((prefix (file-name-as-directory (expand-file-name prefix "~"))) - (config (expand-file-name config gnus-home-directory))) - `(gnus-search-engine gnus-search-notmuch - (remove-prefix ,prefix) - (config-file ,config)))) - -;;; Org links -(defun jao-notmuch-gnus--fname (id) - (let ((cmd (format "notmuch search --output=files id:%s" id))) - (car (split-string (shell-command-to-string cmd))))) - -(defun jao-notmuch-gnus-org-follow (id) - (when-let* ((fname (jao-notmuch-gnus--fname id)) - (group (jao-notmuch-gnus-file-to-group fname))) - (org-gnus-follow-link group id))) - -(defun jao-notmuch-gnus-org-store () - (when-let (d (or (when (derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) - (cons (notmuch-show-get-message-id) - (notmuch-show-get-subject))) - (when (derived-mode-p 'gnus-summary-mode 'gnus-article-mode) - (cons (jao-notmuch-gnus-message-id) - (gnus-summary-article-subject))))) - (org-link-store-props :type "mail" - :link (concat "mail:" (car d)) - :description (concat "Mail: " (cdr d))))) - -(org-link-set-parameters "mail" - :follow #'jao-notmuch-gnus-org-follow - :store #'jao-notmuch-gnus-org-store) - -(org-link-set-parameters "gnus" :store #'ignore) -(org-link-set-parameters "notmuch" :store #'ignore) - -;;; consult-notmuch - -(with-eval-after-load "consult-notmuch" - (defun jao-notmuch-gnus--open-candidate (candidate) - "Open a notmuch-search completion candidate email in Gnus." - (message "candidate: %S" candidate) - (jao-notmuch-gnus-goto-message (consult-notmuch--thread-id candidate))) - - (defun jao-gnus-consult-notmuch () - "Run a consult-notmuch query that opens candidates in Gnus." - (interactive) - (jao-notmuch-gnus--open-candidate (consult-notmuch--search))) - - (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) - -;;; . -(provide 'jao-notmuch-gnus) -;;; jao-notmuch-gnus.el ends here diff --git a/custom/jao-custom-gnus.el b/custom/jao-custom-gnus.el index 440a44f..70823ef 100644 --- a/custom/jao-custom-gnus.el +++ b/custom/jao-custom-gnus.el @@ -614,6 +614,7 @@ (jao-gnus--notify))) (defun jao-gnus-add-demon () + (interactive) (gnus-demon-add-handler 'jao-gnus--scan 5 1)) (jao-gnus-add-demon) @@ -637,7 +638,7 @@ ("nnml:jao\\.\\(inbox\\|trove\\)" "I" jao-themes-f01) ("nnml:bigml\\.[^aibs]" "W" jao-themes-dimm) ("nnml:jao.hacking" "H" jao-themes-dimm) - ("nnml:jao.write" "W" jao-themes-error) + ("nnml:jao.write" "W" jao-themes-warning) ("nnml:jao.[^isthw]" "J" jao-themes-dimm) (,(format "^nnml:%s" (regexp-opt feeds)) "F" jao-themes-dimm) ("feeds\\.e" "E" jao-themes-dimm) @@ -762,6 +763,15 @@ (with-eval-after-load "consult-recoll" (add-to-list 'consult-recoll-open-fns '("message/rfc822" . jao-gnus-goto-file)))) +;;;; notmuch +(use-package jao-notmuch-gnus + :demand t) + +(jao-load-path "consult-notmuch") + +(use-package consult-notmuch + :bind (:map gnus-group-mode-map ("S" . #'jao-gnus-consult-notmuch))) + ;;; keyboard shortcuts (define-key gnus-article-mode-map "i" 'jao-gnus-show-images) (define-key gnus-summary-mode-map "i" 'jao-gnus-show-images) diff --git a/lib/net/jao-notmuch-gnus.el b/lib/net/jao-notmuch-gnus.el new file mode 100644 index 0000000..5eedd97 --- /dev/null +++ b/lib/net/jao-notmuch-gnus.el @@ -0,0 +1,226 @@ +;;; jao-notmuch-gnus.el --- notmuch-gnus interoperability -*- lexical-binding: t; -*- + +;; Copyright (C) 2022, 2024 jao + +;; Author: jao +;; 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 . + +;;; Commentary: + +;; Helper functions to work in Gnus with mail indexed by notmuch. + +;;; Code: + +(require 'gnus) +(require 'ol-gnus) +(require 'notmuch-show) + +;;; Tagging in notmuch from Gnus buffers + +(defun jao-notmuch-gnus--notmuch-id (id) + (when id (if (string-match "<\\(.+\\)>" id) (match-string 1 id) id))) + +(defun jao-notmuch-gnus-message-id (&optional no-show) + "Find the id of currently selected message in Gnus or notmuch." + (when (and (not no-show) (derived-mode-p 'gnus-summary-mode)) + (save-window-excursion (gnus-summary-show-article))) + (cond (gnus-original-article-buffer + (with-current-buffer gnus-original-article-buffer + (jao-notmuch-gnus--notmuch-id (message-field-value "message-id")))) + ((derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) + (notmuch-show-get-message-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 (&optional id tags no-log) + "Interactively add or remove tags to the current message." + (interactive) + (let* ((id (or id (jao-notmuch-gnus-message-id))) + (current (unless tags (jao-notmuch-gnus-message-tags id))) + (prompt (format "Change tags %s" (string-join current "/"))) + (tags (or tags (notmuch-read-tag-changes current prompt)))) + (notmuch-tag (concat "id:" id) tags) + (unless no-log + (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 &optional id current) + "Toggle the given TAGS list for the current Gnus message." + (let* ((id (or id (jao-notmuch-gnus-message-id))) + (current (or 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)))) + +(defun jao-notmuch-gnus-tag-mark () + "Remove the new tag for an article when it's marked as seen by Gnus." + (when-let (id (jao-notmuch-gnus-message-id t)) + (jao-notmuch-gnus-tag-message id '("-new") t))) + +(add-hook 'gnus-mark-article-hook #'jao-notmuch-gnus-tag-mark) + +(defun jao-notmuch-gnus--group-tags (group) + (when (string-match ".+:\\(.+\\)" group) + (split-string (match-string 1 group) "\\."))) + +(defun jao-notmuch-gnus-tag-on-move (op headers from to _d) + (when-let* ((to-tags (when to (jao-notmuch-gnus--group-tags to))) + (id (jao-notmuch-gnus--notmuch-id (mail-header-id headers)))) + (if (eq op 'delete) + (let ((cur (seq-difference (jao-notmuch-gnus--group-tags from) to-tags))) + (jao-notmuch-gnus-toggle-tags (append cur to-tags) id cur)) + (notmuch-tag (concat "id:" id) + (mapcar (lambda (x) (concat "+" x)) to-tags))))) + +(defun jao-notmuch-gnus-auto-tag () + (add-hook 'gnus-summary-article-move-hook #'jao-notmuch-gnus-tag-on-move) + (add-hook 'gnus-summary-article-expire-hook #'jao-notmuch-gnus-tag-on-move)) + +;;; Gnus search using notmuch + +(add-to-list 'gnus-search-expandable-keys "list") + +(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch) + (expr (head list))) + (format "List:%s" (gnus-search-transform-expression engine (cdr expr)))) + + +;;; 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 (expand-file-name "~/var/mail/gnus") + "Directory where Gnus stores its mail.") + +(defvar jao-notmuch-gnus-leafnode-directory (expand-file-name "~/var/mail/news") + "Directory where leafnode stores its messages as seen by notmuch.") + +(defun jao-notmuch-gnus-file-to-group (file &optional maildir newsdir) + "Compute 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-id-to-file (id) + (when id + (let ((cmd (format "notmuch search --output=files %s" id))) + (string-trim (shell-command-to-string cmd))))) + +(defun jao-notmuch-gnus-goto-message (&optional msg-id filename) + "Open a summary buffer containing the current notmuch article." + (interactive) + (let* ((filename (or filename + (jao-notmuch-gnus-id-to-file msg-id) + (notmuch-show-get-filename))) + (group (when filename (jao-notmuch-gnus-file-to-group filename))) + (msg-id (or msg-id (notmuch-show-get-message-id))) + (msg-id (when msg-id (replace-regexp-in-string "^id:" "" msg-id)))) + (if (and group msg-id) + (org-gnus-follow-link group msg-id) + (message "Couldn't get relevant infos for switching to Gnus.")))) + +(defun jao-notmuch-gnus-engine (prefix config) + (let ((prefix (file-name-as-directory (expand-file-name prefix "~"))) + (config (expand-file-name config gnus-home-directory))) + `(gnus-search-engine gnus-search-notmuch + (remove-prefix ,prefix) + (config-file ,config)))) + +;;; Org links +(defun jao-notmuch-gnus--fname (id) + (let ((cmd (format "notmuch search --output=files id:%s" id))) + (car (split-string (shell-command-to-string cmd))))) + +(defun jao-notmuch-gnus-org-follow (id) + (when-let* ((fname (jao-notmuch-gnus--fname id)) + (group (jao-notmuch-gnus-file-to-group fname))) + (org-gnus-follow-link group id))) + +(defun jao-notmuch-gnus-org-store () + (when-let (d (or (when (derived-mode-p 'notmuch-show-mode 'notmuch-tree-mode) + (cons (notmuch-show-get-message-id) + (notmuch-show-get-subject))) + (when (derived-mode-p 'gnus-summary-mode 'gnus-article-mode) + (cons (jao-notmuch-gnus-message-id) + (gnus-summary-article-subject))))) + (org-link-store-props :type "mail" + :link (concat "mail:" (car d)) + :description (concat "Mail: " (cdr d))))) + +(org-link-set-parameters "mail" + :follow #'jao-notmuch-gnus-org-follow + :store #'jao-notmuch-gnus-org-store) + +(org-link-set-parameters "gnus" :store #'ignore) +(org-link-set-parameters "notmuch" :store #'ignore) + +;;; consult-notmuch + +(with-eval-after-load "consult-notmuch" + (defun jao-notmuch-gnus--open-candidate (candidate) + "Open a notmuch-search completion candidate email in Gnus." + (message "candidate: %S" candidate) + (jao-notmuch-gnus-goto-message (consult-notmuch--candidate-id candidate))) + + (defun jao-gnus-consult-notmuch () + "Run a consult-notmuch query that opens candidates in Gnus." + (interactive) + (jao-notmuch-gnus--open-candidate (consult-notmuch--search))) + + (consult-customize jao-gnus-consult-notmuch :preview-key 'any)) + +;;; . +(provide 'jao-notmuch-gnus) +;;; jao-notmuch-gnus.el ends here -- cgit v1.2.3