New gnus-search backend instead of nnir.
This commit is contained in:
parent
461a252813
commit
f639efc649
21
README.org
21
README.org
|
@ -1,22 +1,23 @@
|
||||||
#+TITLE: nnir-mu
|
#+TITLE: gnus-search-mu
|
||||||
|
|
||||||
An mu search backend for Gnus' nnir.
|
An mu search engine for Gnus' search facility.
|
||||||
|
|
||||||
Of course mu is required and must be set up properly for the groups
|
Of course mu is required and must be set up properly for the groups you want to search. This works
|
||||||
you want to search. This works almost identically to the current
|
almost identically to the current notmuch engine.
|
||||||
notmuch engine.
|
|
||||||
|
|
||||||
* Enable
|
* Enable
|
||||||
To start using it can be as simple as;
|
To start using it can be as simple as;
|
||||||
#+begin_src emacs-lisp
|
#+begin_src emacs-lisp
|
||||||
(add-to-list 'load-path "/path/to/nnir-mu")
|
(add-to-list 'load-path "/path/to/gnus-search-mu")
|
||||||
(require 'nnir-mu)
|
(require 'gnus-search-mu)
|
||||||
|
|
||||||
;; Then, like any other nnir backend
|
;; Then, like any other nnir backend
|
||||||
(custom-set-variables
|
(custom-set-variables
|
||||||
'(nnir-method-default-engines '((nnmaildir . mu))))
|
'(gnus-search-default-engines '((nnmaildir . gnus-search-mu))))
|
||||||
;; or
|
;; or
|
||||||
(setq nnir-method-default-engines '((nnmaildir . mu)))
|
(setq gnus-search-default-engines '((nnmaildir . gnus-search-mu)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
For configuration options see the header of [[./nnir-mu.el]]
|
For configuration options see the header of [[./gnus-search-mu.el]]. It is designed to fit in with the
|
||||||
|
generic gnus-search design where possible, unlike the gnus-search-notmuch engine (which even prefers
|
||||||
|
to handle some filtering in elisp instead of the query).
|
||||||
|
|
261
gnus-search-mu.el
Normal file
261
gnus-search-mu.el
Normal file
|
@ -0,0 +1,261 @@
|
||||||
|
;;; gnus-search-mu.el --- mu backend for gnus-search -*- lexical-binding: t -*-
|
||||||
|
|
||||||
|
;; Copyright (C) 2021 Jai Flack
|
||||||
|
|
||||||
|
;; Author: Jai Flack <jflack@disroot.org>
|
||||||
|
;; Version: 2020-09-15
|
||||||
|
;; URL: https://git.disroot.org/jflack/gnus-search-mu
|
||||||
|
;; Package-Requires: ((emacs "28.1"))
|
||||||
|
;; Keywords: Gnus gnus-search mu
|
||||||
|
|
||||||
|
;; This file is NOT part of GNU Emacs.
|
||||||
|
|
||||||
|
;; 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
|
||||||
|
|
||||||
|
;; This package provides an `mu' engine for Gnus' search facility as an
|
||||||
|
;; alternative to notmuch or any other backends. It relies on the `mu'
|
||||||
|
;; executable and thus can only search local mail and requires `mu' to
|
||||||
|
;; be configured for your mail setup. Tested with an nnmaildir backend
|
||||||
|
;; synced with mbsync.
|
||||||
|
|
||||||
|
;;; Configuration:
|
||||||
|
|
||||||
|
;; Generally the defaults will work fine but first mu must be installed
|
||||||
|
;; and configured, see mu(1) and mu-init(1). All these options can be
|
||||||
|
;; configured per-server as documented in the manual (removing the
|
||||||
|
;; `gnus-search-mu' prefix of course).
|
||||||
|
|
||||||
|
;; Available options:
|
||||||
|
;; - `gnus-search-mu-program'
|
||||||
|
;; - `gnus-search-mu-switches'
|
||||||
|
;; - `gnus-search-mu-remove-prefix'
|
||||||
|
;; - `gnus-search-mu-config-directory'
|
||||||
|
;; - `gnus-search-mu-config-directory'
|
||||||
|
;; - `gnus-search-mu-raw-queries-p'
|
||||||
|
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'gnus-search)
|
||||||
|
(require 'gnus-art)
|
||||||
|
|
||||||
|
|
||||||
|
(defcustom gnus-search-mu-program "mu"
|
||||||
|
"Name of mu search executable.
|
||||||
|
|
||||||
|
This can also be set per-server."
|
||||||
|
:type '(string)
|
||||||
|
:group 'gnus-search)
|
||||||
|
|
||||||
|
(defcustom gnus-search-mu-switches '()
|
||||||
|
"A list of strings, to be given as additional arguments to mu.
|
||||||
|
|
||||||
|
Changing the format will have no effect because it is forced to
|
||||||
|
\"--format=sexp\".
|
||||||
|
|
||||||
|
This can also be set per-server."
|
||||||
|
:type '(repeat (string))
|
||||||
|
:group 'gnus-search)
|
||||||
|
|
||||||
|
(defcustom gnus-search-mu-remove-prefix (expand-file-name "Mail/" (getenv "HOME"))
|
||||||
|
"The prefix to remove from each file name returned by mu in
|
||||||
|
order to get a group name. Generally this should be set to your
|
||||||
|
path to your mail directory. This is a regular expression.
|
||||||
|
|
||||||
|
This is very similar to `gnus-search-notmuch-remove-prefix' and
|
||||||
|
`gnus-search-namazu-remove-prefix'."
|
||||||
|
:type '(regexp)
|
||||||
|
:group 'gnus-search)
|
||||||
|
|
||||||
|
(defcustom gnus-search-mu-config-directory
|
||||||
|
(expand-file-name "~/.mu")
|
||||||
|
"Configuration directory for mu.
|
||||||
|
|
||||||
|
This can also be set per-server."
|
||||||
|
:type 'file
|
||||||
|
:group 'gnus-search)
|
||||||
|
|
||||||
|
(defcustom gnus-search-mu-raw-queries-p nil
|
||||||
|
"If t, all mu engines will only accept raw search query
|
||||||
|
strings.
|
||||||
|
|
||||||
|
This is very similar to `gnus-search-notmuch-raw-queries-p'
|
||||||
|
and `gnus-search-namazu-raw-queries-p'.
|
||||||
|
|
||||||
|
This can also be set per-server."
|
||||||
|
:type 'boolean
|
||||||
|
:group 'gnus-search)
|
||||||
|
|
||||||
|
(defclass gnus-search-mu (gnus-search-indexed)
|
||||||
|
((program
|
||||||
|
:initform (symbol-value 'gnus-search-mu-program))
|
||||||
|
(remove-prefix
|
||||||
|
:initform (symbol-value 'gnus-search-mu-remove-prefix))
|
||||||
|
(switches
|
||||||
|
:initform (symbol-value 'gnus-search-mu-switches))
|
||||||
|
(config-directory
|
||||||
|
:initform (symbol-value 'gnus-search-mu-config-directory))
|
||||||
|
(raw-queries-p
|
||||||
|
:initform (symbol-value 'gnus-search-mu-raw-queries-p))))
|
||||||
|
|
||||||
|
|
||||||
|
;; (cl-defmethod gnus-search-transform ((_engine gnus-search-mu)
|
||||||
|
;; (_query null))
|
||||||
|
;; "*")
|
||||||
|
|
||||||
|
(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mu)
|
||||||
|
(expr (head near)))
|
||||||
|
(format "%s near %s"
|
||||||
|
(gnus-search-transform-expression engine (nth 1 expr))
|
||||||
|
(gnus-search-transform-expression engine (nth 2 expr))))
|
||||||
|
|
||||||
|
(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mu)
|
||||||
|
(expr list))
|
||||||
|
(cl-case (car expr)
|
||||||
|
(sender (setf (car expr) 'from))
|
||||||
|
(recipient (setf (car expr) 'to))
|
||||||
|
(mark (setf (car expr) 'tag)))
|
||||||
|
(cl-flet ((mu-date (date)
|
||||||
|
(if (stringp date)
|
||||||
|
date
|
||||||
|
(pcase date
|
||||||
|
(`(nil ,m nil)
|
||||||
|
(nth (1- m) gnus-english-month-names))
|
||||||
|
(`(nil nil ,y)
|
||||||
|
(number-to-string y))
|
||||||
|
(`(,d ,m nil)
|
||||||
|
(format "%02d-%02d" d m))
|
||||||
|
(`(nil ,m ,y)
|
||||||
|
(format "%02d-%02d" m y))
|
||||||
|
(`(,d ,m ,y)
|
||||||
|
(format "%d/%d/%d" m d y))))))
|
||||||
|
(cond
|
||||||
|
((consp (car expr))
|
||||||
|
(format "(%s)" (gnus-search-transform engine expr)))
|
||||||
|
;; ((eql (car expr) 'address)
|
||||||
|
;; (gnus-search-transform engine `((or (from . ,(cdr expr))
|
||||||
|
;; (to . ,(cdr expr))))))
|
||||||
|
;; ((eql (car expr 'body))
|
||||||
|
;; (cdr expr))
|
||||||
|
;; ((memq (car expr) '(from to subject attachment mimetype tag
|
||||||
|
;; id thread folder path lastmod query
|
||||||
|
;; property))
|
||||||
|
;; (when (eql (car expr) 'id)
|
||||||
|
;; (setf (cdr expr) (replace-regexp-in-string "\\`<\\|>\\'"
|
||||||
|
;; ""
|
||||||
|
;; (cdr expr))))
|
||||||
|
;; (format "%s:%s" (car expr)
|
||||||
|
;; (if (string-match "\\`\\*" (cdr expr))
|
||||||
|
;; (replace-match "" nil nil (cdr expr))
|
||||||
|
;; (cdr expr))))
|
||||||
|
((eq (car expr) 'date)
|
||||||
|
(format "date:%s" (mu-date (cdr expr))))
|
||||||
|
((eq (car expr) 'before)
|
||||||
|
(format "date:..%s" (mu-date (cdr expr))))
|
||||||
|
((eq (car expr) 'since)
|
||||||
|
(format "date:%s.." (mu-date (cdr expr))))
|
||||||
|
(t (ignore-errors (cl-call-next-method))))))
|
||||||
|
|
||||||
|
(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-mu))
|
||||||
|
(let ((objcons (car (read-from-string
|
||||||
|
(decode-coding-string
|
||||||
|
(buffer-substring-no-properties
|
||||||
|
(1- (search-forward-regexp "^("))
|
||||||
|
(search-forward-regexp "^)"))
|
||||||
|
'utf-8 t)))))
|
||||||
|
(when (looking-at "\n$")
|
||||||
|
(goto-char (point-max)))
|
||||||
|
(list (plist-get objcons :path) 100)))
|
||||||
|
|
||||||
|
(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mu)
|
||||||
|
(qstring string)
|
||||||
|
query &optional groups)
|
||||||
|
(let ((limit (alist-get 'limit query))
|
||||||
|
;;(thread (alist-get 'thread query))
|
||||||
|
)
|
||||||
|
(with-slots (switches config-directory) engine
|
||||||
|
`("find" ; command must come first
|
||||||
|
,(format "--muhome=%s" config-directory)
|
||||||
|
,@switches
|
||||||
|
,(if limit (format "--maxnum=%d" limit) "")
|
||||||
|
,qstring
|
||||||
|
,@(if groups
|
||||||
|
`("and" "("
|
||||||
|
,@(mapcar (lambda (x)
|
||||||
|
(concat "maildir:/" x))
|
||||||
|
groups)
|
||||||
|
")")
|
||||||
|
"")
|
||||||
|
"--format=sexp"))))
|
||||||
|
|
||||||
|
(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-mu)
|
||||||
|
server query &optional groups)
|
||||||
|
(let ((prefix (slot-value engine 'remove-prefix))
|
||||||
|
(group-regexp (when groups
|
||||||
|
(mapconcat
|
||||||
|
(lambda (x)
|
||||||
|
(regexp-quote (gnus-group-real-name x)))
|
||||||
|
groups "\\|")))
|
||||||
|
artlist vectors article group)
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (not (eobp))
|
||||||
|
(pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
|
||||||
|
(when (and (file-readable-p f-name)
|
||||||
|
(null (file-directory-p f-name))
|
||||||
|
(or (null groups)
|
||||||
|
(and (gnus-search-single-p query)
|
||||||
|
(alist-get 'thread query))
|
||||||
|
(string-match-p group-regexp f-name)))
|
||||||
|
(push (list f-name score) artlist))))
|
||||||
|
;; Are we running an additional grep query?
|
||||||
|
(when-let ((grep-reg (alist-get 'grep query)))
|
||||||
|
(setq artlist (gnus-search-grep-search engine artlist grep-reg)))
|
||||||
|
;; Prep prefix.
|
||||||
|
(when (and prefix (null (string-empty-p prefix)))
|
||||||
|
(setq prefix (file-name-as-directory (expand-file-name prefix))))
|
||||||
|
;; Turn (file-name score) into [group article score].
|
||||||
|
(pcase-dolist (`(,f-name ,score) artlist)
|
||||||
|
(setq article (file-name-nondirectory f-name)
|
||||||
|
group (file-name-directory f-name))
|
||||||
|
;; Remove prefix.
|
||||||
|
(when prefix
|
||||||
|
(setq group (string-remove-prefix prefix group)))
|
||||||
|
;; Break the directory name down until it's something that
|
||||||
|
;; (probably) can be used as a group name.
|
||||||
|
(setq group
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"[/\\]" "."
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"/?\\(cur\\|new\\|tmp\\)?/\\'" ""
|
||||||
|
(replace-regexp-in-string
|
||||||
|
"^[./\\]" ""
|
||||||
|
group nil t)
|
||||||
|
nil t)
|
||||||
|
nil t))
|
||||||
|
|
||||||
|
(push (vector (gnus-group-full-name group server)
|
||||||
|
(if (string-match-p "\\`[[:digit:]]+\\'" article)
|
||||||
|
(string-to-number article)
|
||||||
|
(nnmaildir-base-name-to-article-number
|
||||||
|
(substring article 0 (string-match ":" article))
|
||||||
|
group (string-remove-prefix "nnmaildir:" server)))
|
||||||
|
(if (numberp score)
|
||||||
|
score
|
||||||
|
(string-to-number score)))
|
||||||
|
vectors))
|
||||||
|
vectors))
|
||||||
|
|
||||||
|
(provide 'gnus-search-mu)
|
137
nnir-mu.el
137
nnir-mu.el
|
@ -1,137 +0,0 @@
|
||||||
;;; nnmu.el --- mu backend for nnir -*- lexical-binding: t -*-
|
|
||||||
|
|
||||||
;; Copyright (C) 2020 Jai Flack
|
|
||||||
|
|
||||||
;; Author: Jai Flack <jflack@disroot.org>
|
|
||||||
;; Version: 2020-09-15
|
|
||||||
;; URL: https://git.disroot.org/jflack/nnir-mu
|
|
||||||
;; Package-Requires: ((emacs "24.1"))
|
|
||||||
;; Keywords: Gnus nnir mu
|
|
||||||
|
|
||||||
;; This file is NOT part of GNU Emacs.
|
|
||||||
|
|
||||||
;; 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
|
|
||||||
|
|
||||||
;; This package provides an `mu' backend for Gnus' nnir as an
|
|
||||||
;; alternative to notmuch or any other backends. It relies on the `mu'
|
|
||||||
;; executable and thus can only search local mail and requires `mu' to
|
|
||||||
;; be configured for your mail setup. Tested with an nnmaildir backend
|
|
||||||
;; synced with mbsync.
|
|
||||||
|
|
||||||
;;; Configuration:
|
|
||||||
|
|
||||||
;; Generally the defaults will work find but first mu must be
|
|
||||||
;; installed and configured, see mu(1) and mu-init(1).
|
|
||||||
|
|
||||||
;; Available options:
|
|
||||||
;; - `nnir-mu-program'
|
|
||||||
;; - `nnir-mu-remove-prefix'
|
|
||||||
|
|
||||||
;;; Code:
|
|
||||||
|
|
||||||
(require 'nnir)
|
|
||||||
|
|
||||||
|
|
||||||
(defcustom nnir-mu-program "mu"
|
|
||||||
"Name of mu search executable."
|
|
||||||
:type '(string)
|
|
||||||
:group 'nnir)
|
|
||||||
|
|
||||||
(defcustom nnir-mu-additional-switches '()
|
|
||||||
"A list of strings, to be given as additional arguments to mu."
|
|
||||||
:type '(repeat (string))
|
|
||||||
:group 'nnir)
|
|
||||||
|
|
||||||
(defcustom nnir-mu-remove-prefix nil
|
|
||||||
"The prefix to remove from each file name returned by notmuch
|
|
||||||
in order to get a group name. Generally this should be set to
|
|
||||||
your path to your mail directory. This is a regular expression.
|
|
||||||
|
|
||||||
If it is `nil' then the maildir returned from mu will be used
|
|
||||||
instead. This can be an expensive process but works without any
|
|
||||||
configuration.
|
|
||||||
|
|
||||||
This is very similar to `nnir-notmuch-remove-prefix' and
|
|
||||||
`nnir-namazu-remove-prefix'."
|
|
||||||
:type '(regexp)
|
|
||||||
:group 'nnir)
|
|
||||||
|
|
||||||
;; TODO: part of notmuch engine
|
|
||||||
;; (defcustom nnir-mu-filter-group-names-function nil)
|
|
||||||
|
|
||||||
|
|
||||||
(defun nnir-run-mu (query server &optional groups)
|
|
||||||
"Run QUERY against mu."
|
|
||||||
(message "nnir-run-mu: ")
|
|
||||||
(save-excursion
|
|
||||||
(let* (artlist
|
|
||||||
(qstring (cdr (assq 'query query)))
|
|
||||||
(prefix (nnir-read-server-parm 'nnir-mu-remove-prefix server))
|
|
||||||
(article-pattern (if (string-prefix-p "nnmaildir:"
|
|
||||||
(gnus-group-server server))
|
|
||||||
":[0-9]+"
|
|
||||||
"^[0-9]+$")))
|
|
||||||
(when (string-equal "" qstring)
|
|
||||||
(error "mu: You need a search term"))
|
|
||||||
|
|
||||||
(set-buffer (gnus-get-buffer-create nnir-tmp-buffer))
|
|
||||||
(erase-buffer)
|
|
||||||
|
|
||||||
(let ((cp-list `(,nnir-mu-program
|
|
||||||
nil
|
|
||||||
t
|
|
||||||
nil
|
|
||||||
"find"
|
|
||||||
"--format=sexp"
|
|
||||||
,@(nnir-read-server-parm 'nnir-mu-additional-switches
|
|
||||||
server)
|
|
||||||
,qstring)))
|
|
||||||
(apply #'call-process cp-list))
|
|
||||||
|
|
||||||
(goto-char (point-min))
|
|
||||||
(let (point-start objcons filenam artno dirnam)
|
|
||||||
(while (not (looking-at "\n$"))
|
|
||||||
(setq objcons (car
|
|
||||||
(read-from-string
|
|
||||||
(decode-coding-string
|
|
||||||
(buffer-substring-no-properties
|
|
||||||
(1- (search-forward-regexp "^(" nil t))
|
|
||||||
(search-forward-regexp "^)" nil t))
|
|
||||||
'utf-8 t))))
|
|
||||||
(setq filenam (plist-get objcons :path)
|
|
||||||
artno (file-name-nondirectory filenam)
|
|
||||||
dirnam (file-name-directory filenam))
|
|
||||||
|
|
||||||
(when (and (string-match article-pattern artno)
|
|
||||||
(not (null dirnam)))
|
|
||||||
(unless prefix
|
|
||||||
(setq prefix (string-trim-right filenam
|
|
||||||
(concat (regexp-quote
|
|
||||||
(plist-get objcons
|
|
||||||
:maildir))
|
|
||||||
".*"))))
|
|
||||||
(print (list dirnam artno "" prefix server artlist))
|
|
||||||
(nnir-add-result dirnam artno "" prefix server artlist))))
|
|
||||||
|
|
||||||
(message "Getting massaged by mu...done")
|
|
||||||
|
|
||||||
artlist)))
|
|
||||||
|
|
||||||
|
|
||||||
(add-to-list 'nnir-engines '(mu nnir-run-mu
|
|
||||||
()))
|
|
||||||
|
|
||||||
(provide 'nnir-mu)
|
|
Loading…
Reference in a new issue