From 8e2d4b9368237b7d356e491245c8445b59bfb4a9 Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 21 Sep 2025 16:00:30 +0100 Subject: recoll searches in gnus factored out --- custom/jao-custom-gnus.el | 58 ++++++------------------------------ lib/jao-recoll.el | 76 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 85 insertions(+), 49 deletions(-) create mode 100644 lib/jao-recoll.el diff --git a/custom/jao-custom-gnus.el b/custom/jao-custom-gnus.el index ec6c761..97201ad 100644 --- a/custom/jao-custom-gnus.el +++ b/custom/jao-custom-gnus.el @@ -127,49 +127,8 @@ gnus-permanently-visible-groups "^nnselect:.*" gnus-search-ignored-newsgroups "nndraft.*\\|nnselect.*") -(with-eval-after-load "gnus-search" - (defclass gnus-search-recoll (gnus-search-indexed) - ((separator :type string :initform ".") - (program :initform "recoll") - (raw-queries-p :initform t))) - - (cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-recoll)) - (prog1 (and (looking-at "^file://\\(.+\\)$") (list (match-string 1) 100)) - (forward-line 1))) - - (cl-defmethod gnus-search-transform-expression ((_engine gnus-search-recoll) - expr) - expr) - - (cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-recoll) - (qstring string) - query - &optional groups) - (let* ((subdir (slot-value engine 'remove-prefix)) - (sep (slot-value engine 'separator)) - (gdirs (mapcar (lambda (g) - (let ((g (gnus-group-short-name g))) - (replace-regexp-in-string "\\." sep g))) - (or groups - (and (not (string= "" subdir)) (list subdir))))) - (dirsq (and gdirs - (concat "(" - (mapconcat (lambda (d) (format "dir:%s" d)) - gdirs " OR ") - ")"))) - (qstring (if (string-prefix-p "id:" qstring) - (replace-regexp-in-string "<\\|>" "\"" qstring) - qstring)) - (qstring (if (cdr (assoc 'thread query)) - (concat qstring " OR " - (replace-regexp-in-string "id:\"" "ref:\"" - qstring)) - qstring)) - (qstring (replace-regexp-in-string " or " " OR " qstring)) - (qstring (replace-regexp-in-string " and " " AND " qstring)) - (q (format "mime:message %s (%s)" dirsq qstring))) - ;; (message "query is: %s -- %S" q query) - `("-b" "-t" "-q" ,q)))) +(use-package jao-recoll + :if (jao-is-linux)) ;; (add-to-list 'gnus-parameters '("^nnselect:.*" (nnselect-rescan . t))) @@ -230,7 +189,7 @@ '("local/" "feeds/"))) (ims (mapcar (lambda (b) `(imap :server "127.0.0.1" :port 1143 - :user "mail@jao.io" :password ,pwd + :user "jaor@pm.me" :password ,pwd :stream starttls :predicate "1:*" :fetchflag "\\Deleted \\Seen" :mailbox ,(concat "Labels/#" b))) @@ -240,11 +199,12 @@ (when jao-gnus-use-nnml (add-to-list + ;; `(nnml "" ,(jao-recoll-gnus-search-engine (jao-gnus-dir "Mail/"))) 'gnus-secondary-select-methods - ;; `(nnml "" (gnus-search-engine gnus-search-recoll - ;; (remove-prefix ,(jao-gnus-dir "Mail/")))) - `(nnml "" (gnus-search-engine gnus-search-notmuch - (remove-prefix "/home/jao/var/mail/gnus"))))) + `(nnml "" + (gnus-search-engine gnus-search-notmuch + (remove-prefix + ,(expand-file-name "gnus" jao-maildir)))))) (when jao-gnus-use-nnml (dolist (p jao-gnus-nnml-group-params) @@ -817,7 +777,7 @@ (use-package consult-notmuch :ensure t - :bind (:map gnus-group-mode-map ("S" . #'jao-gnus-consult-notmuch))) + :bind (:map gnus-group-mode-map ("/" . #'jao-gnus-consult-notmuch))) ;;; keyboard shortcuts (define-key gnus-article-mode-map "i" 'jao-gnus-show-images) diff --git a/lib/jao-recoll.el b/lib/jao-recoll.el new file mode 100644 index 0000000..364dfb5 --- /dev/null +++ b/lib/jao-recoll.el @@ -0,0 +1,76 @@ +;;; jao-recoll.el --- Utilities to use recoll -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Jose Antonio Ortega Ruiz + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: mail, text + +;; 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: + +;; Notably, a half-backed backend for Gnus + +;;; Code: + +(require 'gnus-search) + +(defclass gnus-search-recoll (gnus-search-indexed) + ((separator :type string :initform ".") + (program :initform "recoll") + (raw-queries-p :initform t))) + +(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-recoll)) + (prog1 (and (looking-at "^file://\\(.+\\)$") (list (match-string 1) 100)) + (forward-line 1))) + +(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-recoll) + expr) + expr) + +(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-recoll) + (qstring string) + query + &optional groups) + (let* ((subdir (slot-value engine 'remove-prefix)) + (sep (slot-value engine 'separator)) + (gdirs (mapcar (lambda (g) + (let ((g (gnus-group-short-name g))) + (replace-regexp-in-string "\\." sep g))) + (or groups + (and (not (string= "" subdir)) (list subdir))))) + (dirsq (and gdirs + (concat "(" + (mapconcat (lambda (d) (format "dir:%s" d)) + gdirs " OR ") + ")"))) + (qstring (if (string-prefix-p "id:" qstring) + (replace-regexp-in-string "<\\|>" "\"" qstring) + qstring)) + (qstring (if (cdr (assoc 'thread query)) + (concat qstring " OR " + (replace-regexp-in-string "id:\"" "ref:\"" + qstring)) + qstring)) + (qstring (replace-regexp-in-string " or " " OR " qstring)) + (qstring (replace-regexp-in-string " and " " AND " qstring)) + (q (format "mime:message %s (%s)" dirsq qstring))) + ;; (message "query is: %s -- %S" q query) + `("-b" "-t" "-q" ,q))) + +(defun jao-recoll-gnus-search-engine (dir) + `(nnml "" (gnus-search-engine gnus-search-recoll (remove-prefix ,dir)))) + +(provide 'jao-recoll) +;;; jao-recoll.el ends here -- cgit v1.2.3