master 77f3bc37e1: Add a mu backend for gnus-search

[Lars Ingebrigtsen]

branch: master
commit 77f3bc37e1966c15691421585af4d4b9f8114594
Author: Jai Flack <jflack@disroot.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add a 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 (bug#54662).
---
 doc/misc/gnus.texi       |   9 ++-
 etc/NEWS                 |   5 ++
 lisp/gnus/gnus-search.el | 142 +++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 153 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 @@ are:
 
 @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 @@ buffer.  That might look like:
      (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 @@ The customization options are formed on the pattern
 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 6b7bb7a18e..564bd16022 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -818,6 +818,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..6c70257f42 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -349,6 +349,41 @@ This variable can also be set per-server."
   :version "28.1"
   :type 'boolean)
 
+(defcustom gnus-search-mu-program "mu"
+  "Name of the mu search executable.
+This can also be set per-server."
+  :version "29.1"
+  :type 'string)
+
+(defcustom gnus-search-mu-switches nil
+  "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 +938,18 @@ quirks.")
    (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 +1896,101 @@ Assume \"size\" key is equal to \"larger\"."
           (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)