From 77f3bc37e1966c15691421585af4d4b9f8114594 Mon Sep 17 00:00:00 2001 From: Jai Flack Date: Thu, 7 Apr 2022 13:14:01 +0200 Subject: [PATCH] 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 eb93269721c..9faace1a75e 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 6b7bb7a18eb..564bd16022d 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 4ca873eeec9..6c70257f42f 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) -- 2.39.5