Subject: bug#54662: 29.0.50; [PATCH] An mu backend for gnus-search

From: Jai Flack <[email-masked]>
Date: Fri, 01 Apr 2022 11:39:17 +1000

>From 15214b484ab11bdac59644e9fa937d2af4e9f587 Mon Sep 17 00:00:00 2001
From: Jai Flack <[email-masked]>
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

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