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