From: Jai Flack via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: 54662@debbugs.gnu.org
Cc: Eric Abrahamsen <eric@ericabrahamsen.net>
Subject: bug#54662: 29.0.50; [PATCH] An mu backend for gnus-search
Date: Fri, 01 Apr 2022 11:39:17 +1000 [thread overview]
Message-ID: <87ee2hk2ey.fsf@disroot.org> (raw)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1: 0001-An-mu-backend-for-gnus-search.patch --]
[-- Type: text/x-diff, Size: 8086 bytes --]
From 15214b484ab11bdac59644e9fa937d2af4e9f587 Mon Sep 17 00:00:00 2001
From: Jai Flack <jflack@disroot.org>
Date: Fri, 1 Apr 2022 11:13:11 +1000
Subject: [PATCH] An mu backend for gnus-search
* lisp/gnus-search.el (gnus-search-mu-program): New defcustom
(gnus-search-mu-switches): New defcustom
(gnus-search-mu-remove-prefix): New defcustom
(gnus-search-mu-config-directory): New defcustom
(gnus-search-mu-raw-queries-p): New defcustom
(gnus-search-mu): New subclass of gnus-search-indexed
(gnus-search-transform-expression): New method
(gnus-search-mu-handle-date): New function
(gnus-search-mu-handle-flag): New function
(gnus-search-indexed-extract): New method
(gnus-search-indexed-search-command): New method
---
doc/misc/gnus.texi | 9 ++-
etc/NEWS | 5 ++
lisp/gnus/gnus-search.el | 143 +++++++++++++++++++++++++++++++++++++++
3 files changed, 154 insertions(+), 3 deletions(-)
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index eb93269721..9faace1a75 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -21651,6 +21651,9 @@ Search Engines
@item
@code{gnus-search-namazu}
+
+@item
+@code{gnus-search-mu}
@end itemize
If you need more granularity, you can specify a search engine in the
@@ -21665,7 +21668,7 @@ Search Engines
(config-file "/home/user/.mail/.notmuch_config")))
@end example
-Search engines like notmuch, namazu and mairix are similar in
+Search engines like notmuch, namazu, mairix and mu are similar in
behavior: they use a local executable to create an index of a message
store, and run command line search queries against those messages,
and return a list of absolute file names of matching messages.
@@ -21704,8 +21707,8 @@ Search Engines
non-standard notmuch program, you might set
@code{gnus-search-notmuch-program} to @file{/usr/local/bin/notmuch}.
This would apply to all notmuch engines. The engines that use these
-options are: ``notmuch'', ``namazu'', ``mairix'', ``swish-e'' and
-``swish++''.
+options are: ``notmuch'', ``namazu'', ``mairix'', ``mu'', ``swish-e''
+and ``swish++''.
Alternately, the options can be set directly on your Gnus server
definitions, for instance, in the @code{nnmaildir} example above.
diff --git a/etc/NEWS b/etc/NEWS
index aaab0f4517..7f65d24378 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -786,6 +786,11 @@ displayed as emojis. Default nil.
This is bound to 'W D e' and will display symbols that have emoji
representation as emojis.
++++
+*** New mu backend for gnus-search.
+Configuration is very similar to the notmuch and namazu backends. It supports
+the unified search syntax.
+
** EIEIO
+++
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 4ca873eeec..a7150b7652 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -349,6 +349,42 @@ gnus-search-mairix-raw-queries-p
:version "28.1"
:type 'boolean)
+(defcustom gnus-search-mu-program "mu"
+ "Name of mu search executable.
+This can also be set per-server."
+ :version "29.1"
+ :type '(string))
+
+(defcustom gnus-search-mu-switches '()
+ "A list of strings, to be given as additional arguments to mu.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mu-switches \"-u -r\")
+Instead, use this:
+ (setq gnus-search-mu-switches \\='(\"-u\" \"-r\"))
+This can also be set per-server."
+ :version "29.1"
+ :type '(repeat (string)))
+
+(defcustom gnus-search-mu-remove-prefix (expand-file-name "Mail/" "~")
+ "A prefix to remove from the mu results to get a group name.
+Usually this will be set to the path to your mail directory. This
+can also be set per-server."
+ :version "29.1"
+ :type '(directory))
+
+(defcustom gnus-search-mu-config-directory
+ (expand-file-name "~/.cache/mu")
+ "Configuration directory for mu.
+This can also be set per-server."
+ :version "29.1"
+ :type 'file)
+
+(defcustom gnus-search-mu-raw-queries-p nil
+ "If t, all mu engines will only accept raw search query strings.
+This can also be set per-server."
+ :version "29.1"
+ :type 'boolean)
+
;; Options for search language parsing.
(defcustom gnus-search-expandable-keys
@@ -903,6 +939,18 @@ gnus-search-notmuch
(raw-queries-p
:initform (symbol-value 'gnus-search-notmuch-raw-queries-p))))
+(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))))
+
(define-obsolete-variable-alias 'nnir-method-default-engines
'gnus-search-default-engines "28.1")
@@ -1849,6 +1897,101 @@ gnus-search-indexed-search-command
(when (alist-get 'thread query) (list "-t"))
(list qstring))))
+;;; Mu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mu)
+ (expr list))
+ (cl-case (car expr)
+ (recipient (setf (car expr) 'recip))
+ (address (setf (car expr) 'contact))
+ (id (setf (car expr) 'msgid))
+ (attachment (setf (car expr) 'file)))
+ (cl-flet ()
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Explicitly leave out 'date as gnus-search will encode it
+ ;; first; it is handled later
+ ((memq (car expr) '(cc c bcc h from f to t subject s body b
+ maildir m msgid i prio p flag g d
+ size z embed e file j mime y tag x
+ list v))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'mark)
+ (format "flag:%s" (gnus-search-mu-handle-flag (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (gnus-search-mu-handle-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (gnus-search-mu-handle-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (gnus-search-mu-handle-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(defun gnus-search-mu-handle-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))
+ ;; mu prefers ISO date YYYY-MM-DD HH:MM:SS
+ (`(,d ,m nil)
+ (let* ((ct (decode-time))
+ (cm (decoded-time-month ct))
+ (cy (decoded-time-year ct))
+ (y (if (> cm m)
+ cy
+ (1- cy))))
+ (format "%d-%02d-%02d" y m d)))
+ (`(nil ,m ,y)
+ (format "%d-%02d" y m))
+ (`(,d ,m ,y)
+ (format "%d-%02d-%02d" y m d)))))
+
+(defun gnus-search-mu-handle-flag (flag)
+ ;; Only change what doesn't match
+ (cond ((string= flag "flag")
+ "flagged")
+ ((string= flag "read")
+ "seen")
+ (t
+ flag)))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-mu))
+ (prog1
+ (let ((bol (line-beginning-position))
+ (eol (line-end-position)))
+ (list (buffer-substring-no-properties bol eol)
+ 100))
+ (move-beginning-of-line 2)))
+
+(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
+ "--nocolor" ; mu will always give coloured output otherwise
+ ,(format "--muhome=%s" config-directory)
+ ,@switches
+ ,(if thread "-r" "")
+ ,(if limit (format "--maxnum=%d" limit) "")
+ ,qstring
+ ,@(if groups
+ `("and" "("
+ ,@(nbutlast (mapcan (lambda (x)
+ (list (concat "maildir:/" x) "or"))
+ groups))
+ ")")
+ "")
+ "--format=plain"
+ "--fields=l"))))
+
;;; Find-grep interface
(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
--
2.30.2
[-- Attachment #2: Type: text/plain, Size: 178 bytes --]
Greetings,
This is as discussed on emacs-devel.
I haven't heard anything back from savannah.nongnu.org about repository
approval yet for the GNU ELPA package.
--
Thanks,
Jai
next reply other threads:[~2022-04-01 1:39 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-04-01 1:39 Jai Flack via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2022-04-02 14:58 ` bug#54662: 29.0.50; [PATCH] An mu backend for gnus-search Lars Ingebrigtsen
2022-04-02 15:13 ` Corwin Brust
2022-04-02 15:25 ` Eric Abrahamsen
2022-04-02 15:28 ` Corwin Brust
2022-04-02 16:12 ` Eric Abrahamsen
2022-04-02 16:14 ` Corwin Brust
2022-04-03 2:28 ` Jai Flack
2022-04-02 15:21 ` Eric Abrahamsen
2022-04-02 15:26 ` Lars Ingebrigtsen
2022-04-03 2:26 ` Jai Flack
2022-04-03 12:00 ` Lars Ingebrigtsen
2022-04-03 14:53 ` Jai Flack
2022-04-04 10:30 ` Lars Ingebrigtsen
2022-04-04 12:29 ` Jai Flack
2022-04-06 9:15 ` Lars Ingebrigtsen
2022-04-06 23:31 ` Jai Flack
2022-04-07 11:14 ` Lars Ingebrigtsen
2022-04-07 11:26 ` Jai Flack
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87ee2hk2ey.fsf@disroot.org \
--to=bug-gnu-emacs@gnu.org \
--cc=54662@debbugs.gnu.org \
--cc=eric@ericabrahamsen.net \
--cc=jflack@disroot.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).