* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
@ 2020-10-15 16:47 Eric Abrahamsen
2020-10-16 5:08 ` Lars Ingebrigtsen
0 siblings, 1 reply; 14+ messages in thread
From: Eric Abrahamsen @ 2020-10-15 16:47 UTC (permalink / raw)
To: 44016
[-- Attachment #1: Type: text/plain, Size: 1887 bytes --]
Now that the nnselect Gnus backend is in, I've been able to finish the
gnus-search.el library from... four years ago or more. There's a
scratch/gnus-search branch in the repo but it was so old merging was a
pain, so I'm going to just delete it. I've attached a work-in-progress
patch.
To recap: with this library, you can set
`gnus-search-use-parsed-queries' non-nil, and use the same generalized
search query language against all supported search engines. A query
might look like:
from:"my boss" mark:flag since:1w
That same query would work against an IMAP group, or a nnmaildir group
indexed with notmuch, or even multiple groups backed by different search
engines, and the results will be collected correctly. Using nnselect,
the above group could be made permanent, so you'd have a
continually-updating group displaying recent important messages from
your boss.
Some open questions:
- This patch doesn't include documentation, though I have that around
here somewhere. I'll fix it up and add it.
- This patch doesn't remove the nnir.el library, though that's now
obsolete. I think removing it could be problematic: it's not like
declaring functions/variables obsolete, where we can let people down
gently. I suspect plenty of code uses (require 'nnir), which will
cause blowups. Renaming gnus-search.el to nnir.el doesn't make a lot
of sense, though. I'm considering leaving the nnir.el file in there,
but containing nothing but a warning.
- There's "clever" completion stuff in there, that allows search keys to
be completed either during entry, with TAB, or programmatically, after
the query has been entered. I suspect I'm not using quite the right
functions, particularly `completion-in-region' which sort of looks
like it's not meant to be used the way I'm using it -- it seems to
return messages directly.
Anyway, comments very welcome!
Eric
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus-search.diff --]
[-- Type: text/x-patch, Size: 94388 bytes --]
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 1d614f8a8d..c6f7e1c41a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -3165,29 +3165,27 @@ gnus-group-make-directory-group
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-
-(autoload 'nnir-read-parms "nnir")
-(autoload 'nnir-server-to-search-engine "nnir")
(autoload 'gnus-group-topic-name "gnus-topic")
+(autoload 'gnus-search-make-spec "gnus-search")
;; Temporary to make group creation easier
-(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-make-search-group (no-parse &optional specs)
"Make a group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let ((name (gnus-read-group "Group name: ")))
(with-current-buffer gnus-group-buffer
(let* ((group-spec
(or
- (cdr (assq 'nnir-group-spec specs))
+ (cdr (assq 'search-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3199,16 +3197,8 @@ gnus-group-make-search-group
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
(query-spec
(or
- (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (cdr (assq 'search-query-spec specs))
+ (gnus-search-make-spec no-parse))))
(gnus-group-make-group
name
(list 'nnselect "nnselect")
@@ -3216,29 +3206,29 @@ gnus-group-make-search-group
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))))
(define-obsolete-function-alias 'gnus-group-make-nnir-group
'gnus-group-read-ephemeral-search-group "28.1")
-(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-read-ephemeral-search-group (no-parse &optional specs)
"Read an nnselect group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
+ (or (cdr (assq 'search-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3249,16 +3239,8 @@ gnus-group-read-ephemeral-search-group
(cdr
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
(query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (or (cdr (assq 'search-query-spec specs))
+ (gnus-search-make-spec no-parse))))
(gnus-group-read-ephemeral-group
(concat "nnselect-" (message-unique-id))
(list 'nnselect "nnselect")
@@ -3268,10 +3250,10 @@ gnus-group-read-ephemeral-search-group
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))
(defun gnus-group-add-to-virtual (n vgroup)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
new file mode 100644
index 0000000000..aca733b218
--- /dev/null
+++ b/lisp/gnus/gnus-search.el
@@ -0,0 +1,2231 @@
+;;; gnus-search.el --- Search facilities for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines a generalized search language, and search engines
+;; that interface with various search programs. It is responsible for
+;; parsing the user's search input, sending that query to the search
+;; engines, and collecting results. Results are in the form of a
+;; vector of vectors, each vector representing a found article. The
+;; nnselect backend interprets that value to create a group containing
+;; the search results.
+
+;; This file was formerly known as nnir. Later, the backend parts of
+;; nnir became nnselect, and only the search functionality was left
+;; here.
+
+;; See the Gnus manual for details of the search language. Tests are
+;; in tests/gnus-search-test.el.
+
+;; The search parsing routines are responsible for accepting the
+;; user's search query as a string and parsing it into a sexp
+;; structure. The function `gnus-search-parse-query' is the entry
+;; point for that. Once the query is in sexp form, it is passed to
+;; the search engines themselves, which are responsible for
+;; transforming the query into a form that the external program can
+;; understand, and then filtering the search results into a format
+;; that nnselect can understand.
+
+;; The general flow is:
+
+;; 1. The user calls one of `gnus-group-make-search-group' or
+;; `gnus-group-make-permanent-search-group' (or a few other entry
+;; points). These functions prompt for a search query, and collect
+;; the groups to search, then create an nnselect group, setting an
+;; 'nnselect-specs group parameter where 'nnselect-function is
+;; `gnus-search-run-query', and 'nnselect-args is the search query and
+;; groups to search.
+
+;; 2. `gnus-search-run-query' is called with 'nnselect-args. It looks
+;; at the groups to search, categorizes them by server, and for each
+;; server finds the search engine to use. It calls each engine's
+;; `gnus-search-run-search' method with the query and groups passed as
+;; arguments, and the results are collected and handed off to the
+;; nnselect group.
+
+;; For information on writing new search engines, see the Gnus manual.
+
+;;; Code:
+
+(require 'gnus-group)
+(require 'gnus-sum)
+(require 'message)
+(require 'gnus-util)
+(require 'eieio)
+(eval-when-compile (require 'cl-lib))
+(autoload 'eieio-build-class-alist "eieio-opt")
+(autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-english-month-names)
+
+;;; Internal Variables:
+
+(defvar gnus-search-memo-query nil
+ "Internal: stores current query.")
+
+(defvar gnus-search-memo-server nil
+ "Internal: stores current server.")
+
+(defvar gnus-search-history ()
+ "Internal history of Gnus searches.")
+
+(define-error 'gnus-search-parse-error "Gnus search parsing error")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-search nil
+ "Search groups in Gnus with assorted search engines."
+ :group 'gnus)
+
+(defcustom gnus-search-use-parsed-queries t
+ "When t, use Gnus' generalized search language.
+The generalized search language is a search language that can be
+used across all search engines that Gnus supports. See the Gnus
+manual for details.
+
+If this option is set to nil, search queries will be passed
+directly to the search engines without being parsed or
+transformed."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(defcustom gnus-search-ignored-newsgroups ""
+ "A regexp to match newsgroups in the active file that should
+ be skipped when searching."
+ :version "24.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+;; Engine-specific configuration options.
+
+(defcustom gnus-search-swish++-configuration-file
+ (expand-file-name "~/Mail/swish++.conf")
+ "Location of Swish++ configuration file.
+This variable can also be set per-server."
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-program "search"
+ "Name of swish++ search executable.
+This variable can also be set per-server."
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-additional-switches '()
+ "A list of strings, to be given as additional arguments to swish++.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish++-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish++-additional-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish++
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-raw-queries-p nil
+ "If t, all Swish++ engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-configuration-file
+ (expand-file-name "~/Mail/swish-e.conf")
+ "Configuration file for swish-e.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-program "search"
+ "Name of swish-e search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-additional-switches '()
+ "A list of strings, to be given as additional arguments to swish-e.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish-e-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish-e-additional-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish-e
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-index-files '()
+ "A list of index files to use with this Swish-e instance.
+This variable can also be set per-server."
+ :type '(repeat file)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-raw-queries-p nil
+ "If t, all Swish-e engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+;; Namazu engine, see <URL:http://www.namazu.org/>
+
+(defcustom gnus-search-namazu-program "namazu"
+ "Name of Namazu search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-index-directory (expand-file-name "~/Mail/namazu/")
+ "Index directory for Namazu.
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-additional-switches '()
+ "A list of strings, to be given as additional arguments to namazu.
+The switches `-q', `-a', and `-s' are always used, very few other switches
+make any sense in this context.
+
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-namazu-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-namazu-additional-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by Namazu
+in order to get a group name (albeit with / instead of .).
+
+For example, suppose that Namazu returns file names such as
+\"/home/john/Mail/mail/misc/42\". For this example, use the following
+setting: (setq gnus-search-namazu-remove-prefix \"/home/john/Mail/\")
+Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
+Gnus knows to remove the \"/42\" and to replace \"/\" with \".\" to
+arrive at the correct group name, \"mail.misc\".
+
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-raw-queries-p nil
+ "If t, all Namazu engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-program "notmuch"
+ "Name of notmuch search executable.
+This variable can also be set per-server."
+ :type '(string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-configuration-file
+ (expand-file-name "~/.notmuch-config")
+ "Configuration file for notmuch.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-additional-switches '()
+ "A list of strings, to be given as additional arguments to notmuch.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-notmuch-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-notmuch-additional-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by notmuch
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-raw-queries-p nil
+ "If t, all Notmuch engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-imap-raw-queries-p nil
+ "If t, all IMAP engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-program "mairix"
+ "Name of mairix search executable.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-configuration-file
+ (expand-file-name "~/.mairixrc")
+ "Configuration file for mairix.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-additional-switches '()
+ "A list of strings, to be given as additional arguments to mairix.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mairix-additional-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnu-search-mairix-additional-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by mairix
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-raw-queries-p nil
+ "If t, all Mairix engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+;; Options for search language parsing.
+
+(defcustom gnus-search-expandable-keys
+ '("from" "subject" "to" "cc" "bcc" "body" "recipient" "date"
+ "mark" "contact" "contact-from" "contact-to" "before" "after"
+ "larger" "smaller" "attachment" "text" "since" "thread"
+ "sender" "address" "tag" "size" "grep" "limit" "raw")
+ "A list of strings representing expandable search keys.
+\"Expandable\" simply means the key can be abbreviated while
+typing in search queries, ie \"subject\" could be entered as
+\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subject\" and \"since\".
+
+Keys can contain hyphens, in which case each section will be
+expanded separately. \"cont\" will expand to \"contact\", for
+instance, while \"c-t\" will expand to \"contact-to\".
+
+Ambiguous abbreviations will raise an error."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-date-keys
+ '("date" "before" "after" "on" "senton" "sentbefore" "sentsince" "since")
+ "A list of keywords whose value should be parsed as a date.
+See the docstring of `gnus-search-parse-query' for information on
+date parsing."
+ :group 'gnus-search
+ :version "26.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-contact-sources nil
+ "A list of sources used to search for messages from contacts.
+Each list element can be either a function, or an alist.
+Functions should accept a search string, and return a list of
+email addresses of matching contacts. An alist should map single
+strings to lists of mail addresses, usable as search keys in mail
+headers."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat (choice function
+ (alist
+ :key-type string
+ :value-type (repeat string)))))
+
+;;; Search language
+
+;; This "language" was generalized from the original IMAP search query
+;; parsing routine.
+
+(defun gnus-search-parse-query (string)
+ "Turn STRING into an s-expression based query.
+The resulting query structure is passed to the various search
+backends, each of which adapts it as needed.
+
+The search \"language\" is essentially a series of key:value
+expressions. Key is most often a mail header, but there are
+other keys. Value is a string, quoted if it contains spaces.
+Key and value are separated by a colon, no space. Expressions
+are implictly ANDed; the \"or\" keyword can be used to
+OR. \"not\" will negate the following expression, or keys can be
+prefixed with a \"-\". The \"near\" operator will work for
+engines that understand it; other engines will convert it to
+\"or\". Parenthetical groups work as expected.
+
+A key that matches the name of a mail header will search that
+header.
+
+Search keys can be abbreviated so long as they remain
+unambiguous, ie \"f\" will search the \"from\" header. \"s\" will
+raise an error.
+
+Other keys:
+
+\"address\" will search all sender and recipient headers.
+
+\"recipient\" will search \"To\", \"Cc\", and \"Bcc\".
+
+\"before\" will search messages sent before the specified
+date (date specifications to come later). Date is exclusive.
+
+\"after\" (or its synonym \"since\") will search messages sent
+after the specified date. Date is inclusive.
+
+\"mark\" will search messages that have some sort of mark.
+Likely values include \"flag\", \"seen\", \"read\", \"replied\".
+It's also possible to use Gnus' internal marks, ie \"mark:R\"
+will be interpreted as mark:read.
+
+\"tag\" will search tags -- right now that's translated to
+\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some
+point this should also be used to search marks in the Gnus
+registry.
+
+\"contact\" will search messages to/from a contact. Contact
+management packages must push a function onto
+`gnus-search-contact-sources', the docstring of which see, for
+this to work.
+
+\"contact-from\" does what you'd expect.
+
+\"contact-to\" searches the same headers as \"recipient\".
+
+Other keys can be specified, provided that the search backends
+know how to interpret them.
+
+Date values (any key in `gnus-search-date-keys') can be provided
+in any format that `parse-time-string' can parse (note that this
+can produce weird results). Dates with missing bits will be
+interpreted as the most recent occurance thereof (ie \"march 03\"
+is the most recent March 3rd). Lastly, relative specifications
+such as 1d (one day ago) are understood. This also accepts w, m,
+and y. m is assumed to be 30 days.
+
+This function will accept pretty much anything as input. Its
+only job is to parse the query into a sexp, and pass that on --
+it is the job of the search backends to make sense of the
+structured query. Malformed, unusable or invalid queries will
+typically be silently ignored."
+ (with-temp-buffer
+ ;; Set up the parsing environment.
+ (insert string)
+ (goto-char (point-min))
+ ;; Now, collect the output terms and return them.
+ (let (out)
+ (while (not (gnus-search-query-end-of-input))
+ (push (gnus-search-query-next-expr) out))
+ (reverse out))))
+
+(defun gnus-search-query-next-expr (&optional count halt)
+ "Return the next expression from the current buffer."
+ (let ((term (gnus-search-query-next-term count))
+ (next (gnus-search-query-peek-symbol)))
+ ;; Deal with top-level expressions. And, or, not, near... What
+ ;; else? Notmuch also provides xor and adj. It also provides a
+ ;; "nearness" parameter for near and adj.
+ (cond
+ ;; Handle 'expr or expr'
+ ((and (eq next 'or)
+ (null halt))
+ (list 'or term (gnus-search-query-next-expr 2)))
+ ;; Handle 'near operator.
+ ((eq next 'near)
+ (let ((near-next (gnus-search-query-next-expr 2)))
+ (if (and (stringp term)
+ (stringp near-next))
+ (list 'near term near-next)
+ (signal 'gnus-search-parse-error
+ (list "\"Near\" keyword must appear between two plain strings.")))))
+ ;; Anything else
+ (t term))))
+
+(defun gnus-search-query-next-term (&optional count)
+ "Return the next TERM from the current buffer."
+ (let ((term (gnus-search-query-next-symbol count)))
+ ;; What sort of term is this?
+ (cond
+ ;; negated term
+ ((eq term 'not) (list 'not (gnus-search-query-next-expr nil 'halt)))
+ ;; generic term
+ (t term))))
+
+(defun gnus-search-query-peek-symbol ()
+ "Return the next symbol from the current buffer, but don't consume it."
+ (save-excursion
+ (gnus-search-query-next-symbol)))
+
+(defun gnus-search-query-next-symbol (&optional count)
+ "Return the next symbol from the current buffer, or nil if we are
+at the end of the buffer. If supplied COUNT skips some symbols before
+returning the one at the supplied position."
+ (when (and (numberp count) (> count 1))
+ (gnus-search-query-next-symbol (1- count)))
+ (let ((case-fold-search t))
+ ;; end of input stream?
+ (unless (gnus-search-query-end-of-input)
+ ;; No, return the next symbol from the stream.
+ (cond
+ ;; Negated expression -- return it and advance one char.
+ ((looking-at "-") (forward-char 1) 'not)
+ ;; List expression -- we parse the content and return this as a list.
+ ((looking-at "(")
+ (gnus-search-parse-query (gnus-search-query-return-string ")" t)))
+ ;; Keyword input -- return a symbol version.
+ ((looking-at "\\band\\b") (forward-char 3) 'and)
+ ((looking-at "\\bor\\b") (forward-char 2) 'or)
+ ((looking-at "\\bnot\\b") (forward-char 3) 'not)
+ ((looking-at "\\bnear\\b") (forward-char 4) 'near)
+ ;; Plain string, no keyword
+ ((looking-at "[\"/]?\\b[^:]+\\([[:blank:]]\\|\\'\\)")
+ (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t)))
+ ;; Assume a K:V expression.
+ (t (let ((key (gnus-search-query-expand-key
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward ":" (point-at-eol) t)
+ (1- (point))))))
+ (value (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t))))
+ (gnus-search-query-parse-kv key value)))))))
+
+(defun gnus-search-query-parse-kv (key value)
+ "Handle KEY and VALUE, parsing and expanding as necessary.
+This may result in (key value) being turned into a larger query
+structure.
+
+In the simplest case, they are simply consed together. String
+KEY is converted to a symbol."
+ (let (return)
+ (cond
+ ((member key gnus-search-date-keys)
+ (when (string= "after" key)
+ (setq key "since"))
+ (setq value (gnus-search-query-parse-date value)))
+ ((string-match-p "contact" key)
+ (setq return (gnus-search-query-parse-contact key value)))
+ ((equal key "mark")
+ (setq value (gnus-search-query-parse-mark value))))
+ (or return
+ (cons (intern key) value))))
+
+(defun gnus-search-query-parse-date (value &optional rel-date)
+ "Interpret VALUE as a date specification.
+See the docstring of `gnus-search-parse-query' for details.
+
+The result is a list of (dd mm yyyy); individual elements can be
+nil.
+
+If VALUE is a relative time, interpret it as relative to
+REL-DATE, or (current-time) if REL-DATE is nil."
+ ;; Time parsing doesn't seem to work with slashes.
+ (let ((value (replace-regexp-in-string "/" "-" value))
+ (now (append '(0 0 0)
+ (seq-subseq (decode-time (or rel-date
+ (current-time)))
+ 3))))
+ ;; Check for relative time parsing.
+ (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
+ (seq-subseq
+ (decode-time
+ (time-subtract
+ (apply #'encode-time now)
+ (days-to-time
+ (* (string-to-number (match-string 1 value))
+ (cdr (assoc (match-string 2 value)
+ '(("d" . 1)
+ ("w" . 7)
+ ("m" . 30)
+ ("y" . 365))))))))
+ 3 6)
+ ;; Otherwise check the value of `parse-time-string'.
+
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+ (let ((d-time (parse-time-string value)))
+ ;; Did parsing produce anything at all?
+ (if (seq-some #'integerp (seq-subseq d-time 3 7))
+ (seq-subseq
+ ;; If DOW is given, handle that specially.
+ (if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
+ (decode-time
+ (time-subtract (apply #'encode-time now)
+ (days-to-time
+ (+ (if (> (seq-elt d-time 6)
+ (seq-elt now 6))
+ 7 0)
+ (- (seq-elt now 6) (seq-elt d-time 6))))))
+ d-time)
+ 3 6)
+ ;; `parse-time-string' failed to produce anything, just
+ ;; return the string.
+ value)))))
+
+(defun gnus-search-query-parse-mark (mark)
+ "Possibly transform MARK.
+If MARK is a single character, assume it is one of the
+gnus-*-mark marks, and return an appropriate string."
+ (if (= 1 (length mark))
+ (let ((m (aref mark 0)))
+ ;; Neither pcase nor cl-case will work here.
+ (cond
+ ((eql m gnus-ticked-mark) "flag")
+ ((eql m gnus-read-mark) "read")
+ ((eql m gnus-replied-mark) "replied")
+ ((eql m gnus-recent-mark) "recent")
+ (t mark)))
+ mark))
+
+(defun gnus-search-query-parse-contact (key value)
+ "Handle VALUE as the name of a contact.
+Runs VALUE through the elements of
+`gnus-search-contact-sources' until one of them returns a list
+of email addresses. Turns those addresses into an appropriate
+chunk of query syntax."
+ (let ((funcs (or (copy-sequence gnus-search-contact-sources)
+ (signal 'gnus-search-parse-error
+ (list "No functions for handling contacts."))))
+ func addresses)
+ (while (and (setq func (pop funcs))
+ (null addresses))
+ (setq addresses (if (functionp func)
+ (funcall func value)
+ (when (string= value (car func))
+ (cdr func)))))
+ (unless addresses
+ (setq addresses (list value)))
+ ;; Simplest case: single From address.
+ (if (and (null (cdr addresses))
+ (equal key "contact-from"))
+ (cons 'sender (car addresses))
+ (cons
+ 'or
+ (mapcan
+ (lambda (a)
+ (pcase key
+ ("contact-from"
+ (list (cons 'sender a)))
+ ("contact-to"
+ (list (cons 'recipient a)))
+ ("contact"
+ (list (cons 'address a)))))
+ addresses)))))
+
+(defun gnus-search-query-expand-key (key)
+ (cond ((test-completion key gnus-search-expandable-keys)
+ ;; We're done!
+ key)
+ ;; There is more than one possible completion.
+ ((consp (cdr (completion-all-completions
+ key gnus-search-expandable-keys #'stringp 0)))
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key))))
+ ;; Return KEY, either completed or untouched.
+ ((car-safe (completion-try-completion
+ key gnus-search-expandable-keys
+ #'stringp 0)))))
+
+(defun gnus-search-query-return-string (&optional delimited trim)
+ "Return a string from the current buffer.
+If DELIMITED is non-nil, assume the next character is a delimiter
+character, and return everything between point and the next
+occurance of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
+return one word."
+ ;; This function cannot handle nested delimiters, as it's not a
+ ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
+ ;; (cc:bob or bcc:bob))".
+ (let ((start (point))
+ (delimiter (if (stringp delimited)
+ delimited
+ (when delimited
+ (char-to-string (char-after)))))
+ end)
+ (if delimiter
+ (progn
+ (when trim
+ ;; Skip past first delimiter if we're trimming.
+ (forward-char 1))
+ (while (not end)
+ (unless (search-forward delimiter nil t (unless trim 2))
+ (signal 'gnus-search-parse-error
+ (list (format "Unmatched delimited input with %s in query" delimiter))))
+ (let ((here (point)))
+ (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+ (setq end (if trim (1- (point)) (point))
+ start (if trim (1+ start) start))))))
+ (setq end (progn (re-search-forward "\\([[:blank:]]+\\|$\\)" (point-max) t)
+ (match-beginning 0))))
+ (buffer-substring-no-properties start end)))
+
+(defun gnus-search-query-end-of-input ()
+ "Are we at the end of input?"
+ (skip-chars-forward "[[:blank:]]")
+ (looking-at "$"))
+
+;;; Search engines
+
+;; Search engines are implemented as classes. This is good for two
+;; things: encapsulating things like indexes and search prefixes, and
+;; transforming search queries.
+
+(defclass gnus-search-engine ()
+ ((raw-queries-p
+ :initarg :raw-queries-p
+ :initform nil
+ :type boolean
+ :custom boolean
+ :documentation
+ "When t, searches through this engine will never be parsed or
+ transformed, and must be entered \"raw\"."))
+ :abstract t
+ :documentation "Abstract base class for Gnus search engines.")
+
+(defclass gnus-search-grep ()
+ ((grep-program
+ :initarg :grep-program
+ :initform "grep"
+ :type string
+ :documentation "Grep executable to use for second-pass grep
+ searches.")
+ (grep-options
+ :initarg :grep-options
+ :initform nil
+ :type list
+ :documentation "Additional options, in the form of a list,
+ passed to the second-pass grep search, when present."))
+ :abstract t
+ :documentation "An abstract mixin class that can be added to
+ local-filesystem search engines, providing an additional grep:
+ search key. After the base engine returns a list of search
+ results (as local filenames), an external grep process is used
+ to further filter the results.")
+
+(cl-defgeneric gnus-search-grep-search (engine artlist criteria)
+ "Run a secondary grep search over a list of preliminary results.
+
+ARTLIST is a list of (filename score) pairs, produced by one of
+the other search engines. CRITERIA is a grep-specific search
+key. This method uses an external grep program to further filter
+the files in ARTLIST by that search key.")
+
+(cl-defmethod gnus-search-grep-search ((engine gnus-search-grep)
+ artlist criteria)
+ (with-slots (grep-program grep-options) engine
+ (if (executable-find grep-program)
+ ;; Don't catch errors -- allow them to propagate.
+ (let ((matched-files
+ (apply
+ #'process-lines
+ grep-program
+ `("-l" ,@grep-options
+ "-e" ,(shell-quote-argument criteria)
+ ,@(mapcar #'car artlist)))))
+ (seq-filter (lambda (a) (member (car a) matched-files))
+ artlist))
+ (nnheader-report 'search "invalid grep program: %s" grep-program))))
+
+(defclass gnus-search-process ()
+ ((proc-buffer
+ :initarg :proc-buffer
+ :type buffer
+ :documentation "A temporary buffer this engine uses for its
+ search process, and for munging its search results."))
+ :abstract t
+ :documentation
+ "A mixin class for engines that do their searching in a single
+ process launched for this purpose, which returns at the end of
+ the search. Subclass instances are safe to be run in
+ threads.")
+
+(cl-defmethod shared-initialize ((engine gnus-search-process)
+ slots)
+ (setq slots (plist-put slots :proc-buffer
+ (get-buffer-create
+ (generate-new-buffer-name " *gnus-search-"))))
+ (cl-call-next-method engine slots))
+
+(defclass gnus-search-imap (gnus-search-engine)
+ ((literal-plus
+ :initarg :literal-plus
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle literal+ searches? This slot
+ is set automatically by the imap server, and cannot be
+ set manually. Only the LITERAL+ capability is handled.")
+ (multisearch
+ :initarg :multisearch
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the MULTISEARCH capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently unimplemented.")
+ (fuzzy
+ :initarg :fuzzy
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the FUZZY search capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently only partially implemented."))
+ :documentation
+ "The base IMAP search engine, using an IMAP server's search capabilites.
+
+This backend may be subclassed to handle particular IMAP servers'
+quirks.")
+
+(eieio-oset-default 'gnus-search-imap 'raw-queries-p
+ gnus-search-imap-raw-queries-p)
+
+(defclass gnus-search-find-grep (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ nil)
+
+(defclass gnus-search-gmane (gnus-search-engine gnus-search-process)
+ nil)
+
+;;; The "indexed" search engine. These are engines that use an
+;;; external program, with indexes kept on disk, to search messages
+;;; usually kept in some local directory. The three common slots are
+;;; "program", holding the string name of the executable; "switches",
+;;; holding additional switches to pass to the executable; and
+;;; "prefix", which is sort of the path to the found messages which
+;;; should be removed so that Gnus can find them. Many of the
+;;; subclasses also allow distinguishing multiple databases or
+;;; indexes. These slots can be set using a global default, or on a
+;;; per-server basis.
+
+(defclass gnus-search-indexed (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ ((program
+ :initarg :program
+ :type string
+ :documentation
+ "The executable used for indexing and searching.")
+ (config-file
+ :init-arg :config-file
+ :type string
+ :custom file
+ :documentation "Location of the config file, if any.")
+ (prefix
+ :initarg :prefix
+ :type string
+ :documentation
+ "The path to the directory where the indexed mails are
+ kept. This path is removed from the search results.")
+ (switches
+ :initarg :switches
+ :type list
+ :documentation
+ "Additional switches passed to the search engine command-line
+ program."))
+ :abstract t
+ :allow-nil-initform t
+ :documentation "A base search engine class that assumes a local search index
+ accessed by a command line program.")
+
+(eieio-oset-default 'gnus-search-indexed 'prefix
+ (concat (getenv "HOME") "/Mail/"))
+
+(defclass gnus-search-swish-e (gnus-search-indexed)
+ ((index-files
+ :init-arg :index-files
+ :type list)))
+
+(eieio-oset-default 'gnus-search-swish-e 'program
+ gnus-search-swish-e-program)
+
+(eieio-oset-default 'gnus-search-swish-e 'prefix
+ gnus-search-swish-e-remove-prefix)
+
+(eieio-oset-default 'gnus-search-swish-e 'index-files
+ gnus-search-swish-e-index-files)
+
+(eieio-oset-default 'gnus-search-swish-e 'switches
+ gnus-search-swish-e-additional-switches)
+
+(eieio-oset-default 'gnus-search-swish-e 'raw-queries-p
+ gnus-search-swish-e-raw-queries-p)
+
+(defclass gnus-search-swish++ (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-swish++ 'program
+ gnus-search-swish++-program)
+
+(eieio-oset-default 'gnus-search-swish++ 'prefix
+ gnus-search-swish++-remove-prefix)
+
+(eieio-oset-default 'gnus-search-swish++ 'config-file
+ gnus-search-swish++-configuration-file)
+
+(eieio-oset-default 'gnus-search-swish++ 'switches
+ gnus-search-swish++-additional-switches)
+
+(eieio-oset-default 'gnus-search-swish++ 'raw-queries-p
+ gnus-search-swish++-raw-queries-p)
+
+(defclass gnus-search-mairix (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-mairix 'program
+ gnus-search-mairix-program)
+
+(eieio-oset-default 'gnus-search-mairix 'switches
+ gnus-search-mairix-additional-switches)
+
+(eieio-oset-default 'gnus-search-mairix 'prefix
+ gnus-search-mairix-remove-prefix)
+
+(eieio-oset-default 'gnus-search-mairix 'config-file
+ gnus-search-mairix-configuration-file)
+
+(eieio-oset-default 'gnus-search-mairix 'raw-queries-p
+ gnus-search-mairix-raw-queries-p)
+
+(defclass gnus-search-namazu (gnus-search-indexed)
+ ((index-dir
+ :initarg :index-dir
+ :type string
+ :custom directory)))
+
+(eieio-oset-default 'gnus-search-namazu 'program
+ gnus-search-namazu-program)
+
+(eieio-oset-default 'gnus-search-namazu 'index-dir
+ gnus-search-namazu-index-directory)
+
+(eieio-oset-default 'gnus-search-namazu 'switches
+ gnus-search-namazu-additional-switches)
+
+(eieio-oset-default 'gnus-search-namazu 'prefix
+ gnus-search-namazu-remove-prefix)
+
+(eieio-oset-default 'gnus-search-namazu 'raw-queries-p
+ gnus-search-namazu-raw-queries-p)
+
+(defclass gnus-search-notmuch (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-notmuch 'program
+ gnus-search-notmuch-program)
+
+(eieio-oset-default 'gnus-search-notmuch 'switches
+ gnus-search-notmuch-additional-switches)
+
+(eieio-oset-default 'gnus-search-notmuch 'prefix
+ gnus-search-notmuch-remove-prefix)
+
+(eieio-oset-default 'gnus-search-notmuch 'config-file
+ gnus-search-notmuch-configuration-file)
+
+(eieio-oset-default 'gnus-search-notmuch 'raw-queries-p
+ gnus-search-notmuch-raw-queries-p)
+
+(make-obsolete-variable 'nnir-method-default-engines
+ "see `gnus-search-default-engines'" "26.1")
+
+(defcustom gnus-search-default-engines '((nnimap gnus-search-imap)
+ (nntp gnus-search-gmane))
+ "Alist of default search engines keyed by server method."
+ :version "26.1"
+ :group 'gnus-search
+ :type `(repeat (list (choice (const nnimap) (const nntp) (const nnspool)
+ (const nneething) (const nndir) (const nnmbox)
+ (const nnml) (const nnmh) (const nndraft)
+ (const nnfolder) (const nnmaildir))
+ (choice
+ ,@(mapcar
+ (lambda (el) (list 'const (intern (car el))))
+ (eieio-build-class-alist 'gnus-search-engine t))))))
+
+;;; Transforming and running search queries.
+
+(cl-defgeneric gnus-search-run-search (engine server query groups)
+ "Run QUERY in GROUPS against SERVER, using search ENGINE.
+Should return results as a vector of vectors.")
+
+(cl-defgeneric gnus-search-transform (engine expression)
+ "Transform sexp EXPRESSION into a string search query usable by ENGINE.
+Responsible for handling and, or, and parenthetical expressions.")
+
+(cl-defgeneric gnus-search-transform-expression (engine expression)
+ "Transform a basic EXPRESSION into a string usable by ENGINE.")
+
+(cl-defgeneric gnus-search-make-query-string (engine query-spec)
+ "Extract the actual query string to use from QUERY-SPEC.")
+
+;; Methods that are likely to be the same for all engines.
+
+(cl-defmethod gnus-search-run-search :around
+ (_engine _server query _groups)
+ "Possibly enforce a limit query clause on search results."
+ ;; Some engines do result limiting on their own, some don't. Just
+ ;; make sure.
+ (let ((artlist (cl-call-next-method))
+ (limit (alist-get 'limit query)))
+ (if limit
+ (cl-subseq artlist 0
+ (min limit (length artlist)))
+ artlist)))
+
+(cl-defmethod gnus-search-make-query-string ((engine gnus-search-engine)
+ query-spec)
+ (if (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec))
+ (null (slot-value engine 'raw-queries-p)))
+ (gnus-search-transform
+ engine (alist-get 'parsed-query query-spec))
+ (alist-get 'query query-spec)))
+
+(defsubst gnus-search-single-p (query)
+ "Return t if QUERY is a search for a single message."
+ (let ((q (alist-get 'parsed-query query)))
+ (and (= (length q ) 1)
+ (consp (car-safe q))
+ (eq (caar q) 'id))))
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-engine)
+ (query list))
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (gnus-search-transform-expression engine item)))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+;; Most search engines just pass through plain strings.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (expr string))
+ expr)
+
+;; Most search engines use implicit ANDs.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (_expr (eql and)))
+ nil)
+
+;; Most search engines use explicit infixed ORs.
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ ;; Unhandled keywords return a nil; don't create an "or" expression
+ ;; unless both sub-expressions are non-nil.
+ (if (and left right)
+ (format "%s or %s" left right)
+ (or left right))))
+
+;; Most search engines just use the string "not"
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head not)))
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (when next
+ (format "not %s" next))))
+
+;;; Search Engine Interfaces:
+
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
+;; imap interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
+ srv query groups)
+ (save-excursion
+ (let ((server (cadr (gnus-server-to-method srv)))
+ (gnus-inhibit-demon t)
+ ;; We're using the message id to look for a single message.
+ (single-search (gnus-search-single-p query))
+ (grouplist (or groups (gnus-search-get-active srv)))
+ q-string artlist group)
+ (message "Opening server %s" server)
+ ;; We should only be doing this once, in
+ ;; `nnimap-open-connection', but it's too frustrating to try to
+ ;; get to the server from the process buffer.
+ (with-current-buffer (nnimap-buffer)
+ (setf (slot-value engine 'literal-plus)
+ (when (nnimap-capability "LITERAL+") t))
+ ;; MULTISEARCH not yet implemented.
+ (setf (slot-value engine 'multisearch)
+ (when (nnimap-capability "MULTISEARCH") t))
+ ;; FUZZY only partially supported: the command is sent to the
+ ;; server (and presumably acted upon), but we don't yet
+ ;; request a RELEVANCY score as part of the response.
+ (setf (slot-value engine 'fuzzy)
+ (when (nnimap-capability "SEARCH=FUZZY") t)))
+
+ (setq q-string
+ (gnus-search-make-query-string engine query))
+
+ ;; If it's a thread query, make sure that all message-id
+ ;; searches are also references searches.
+ (when (alist-get 'thread query)
+ (setq q-string
+ (replace-regexp-in-string
+ "HEADER Message-Id \\([^ )]+\\)"
+ "(OR HEADER Message-Id \\1 HEADER References \\1)"
+ q-string)))
+
+ (while (and (setq group (pop grouplist))
+ (or (null single-search) (null artlist)))
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((result
+ (gnus-search-imap-search-command engine q-string)))
+ (when (car result)
+ (setq artlist
+ (vconcat
+ (mapcar
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (vector group artn 100))))
+ (cdr (assoc "SEARCH" (cdr result))))
+ artlist))))
+ (message "Searching %s...done" group))))
+ artlist)))
+
+(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
+ (query string))
+ "Create the IMAP search command for QUERY.
+
+Currenly takes into account support for the LITERAL+ capability.
+Other capabilities could be tested here."
+ (with-slots (literal-plus) engine
+ (when literal-plus
+ (setq query (split-string query "\n")))
+ (cond
+ ((consp query)
+ ;; We're not really streaming, just need to prevent
+ ;; `nnimap-send-command' from waiting for a response.
+ (let* ((nnimap-streaming t)
+ (call
+ (nnimap-send-command
+ "UID SEARCH CHARSET UTF-8 %s"
+ (pop query))))
+ (dolist (l query)
+ (process-send-string (get-buffer-process (current-buffer)) l)
+ (process-send-string (get-buffer-process (current-buffer))
+ (if (nnimap-newlinep nnimap-object)
+ "\n"
+ "\r\n")))
+ (nnimap-get-response call)))
+ (t (nnimap-command "UID SEARCH %s" query)))))
+
+;; TODO: Don't exclude booleans and date keys, just check for them
+;; before checking for general keywords.
+(defvar gnus-search-imap-search-keys
+ '(body cc bcc from header keyword larger smaller subject text to uid)
+ "Known IMAP search keys, excluding booleans and date keys.")
+
+(cl-defmethod gnus-search-transform ((_ gnus-search-imap)
+ (_query null))
+ "ALL")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr string))
+ (unless (string-match-p "\\`/.+/\\'" expr)
+ ;; Also need to check for fuzzy here. Or better, do some
+ ;; refactoring of this stuff.
+ (format "TEXT %s"
+ (gnus-search-imap-handle-string engine expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ (if (and left right)
+ (format "(OR %s %s)"
+ left (format (if (eq 'or (car-safe (nth 2 expr)))
+ "(%s)" "%s")
+ right))
+ (or left right))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head near)))
+ "Imap searches interpret \"near\" as \"or\"."
+ (setcar expr 'or)
+ (gnus-search-transform-expression engine expr))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head not)))
+ "Transform IMAP NOT.
+If the term to be negated is a flag, then use the appropriate UN*
+boolean instead."
+ (if (eql (caadr expr) 'mark)
+ (if (string= (cdadr expr) "new")
+ "OLD"
+ (format "UN%s" (gnus-search-imap-handle-flag (cdadr expr))))
+ (format "NOT %s"
+ (gnus-search-transform-expression engine (cadr expr)))))
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-imap)
+ (expr (head mark)))
+ (gnus-search-imap-handle-flag (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr list))
+ "Handle a search keyword for IMAP.
+All IMAP search keywords that take a value are supported
+directly. Keywords that are boolean are supported through other
+means (usually the \"mark\" keyword)."
+ (let ((fuzzy-supported (slot-value engine 'fuzzy))
+ (fuzzy ""))
+ (cl-case (car expr)
+ (date (setcar expr 'on))
+ (tag (setcar expr 'keyword))
+ (sender (setcar expr 'from)))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eq (car expr) 'recipient)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr)))))
+ ((eq (car expr) 'address)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "from:%s or to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr) (cdr expr)))))
+ ((memq (car expr) '(before since on sentbefore senton sentsince))
+ ;; Ignore dates given as strings.
+ (when (listp (cdr expr))
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-date engine (cdr expr)))))
+ ((stringp (cdr expr))
+ ;; If the search term starts or ends with "*", remove the
+ ;; asterisk. If the engine supports FUZZY, then additionally make
+ ;; the search fuzzy.
+ (when (string-match "\\`\\*\\|\\*\\'" (cdr expr))
+ (setcdr expr (replace-regexp-in-string
+ "\\`\\*\\|\\*\\'" "" (cdr expr)))
+ (when fuzzy-supported
+ (setq fuzzy "FUZZY ")))
+ ;; If the search term is a regexp, drop the expression altogether.
+ (unless (string-match-p "\\`/.+/\\'" (cdr expr))
+ (cond
+ ((memq (car expr) gnus-search-imap-search-keys)
+ (format "%s%s %s"
+ fuzzy
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-string engine (cdr expr))))
+ ((eq (car expr) 'id)
+ (format "HEADER Message-ID \"%s\"" (cdr expr)))
+ ;; Treat what can't be handled as a HEADER search. Probably a bad
+ ;; idea.
+ (t (format "%sHEADER %s %s"
+ fuzzy
+ (car expr)
+ (gnus-search-imap-handle-string engine (cdr expr))))))))))
+
+(cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap)
+ (date list))
+ "Turn DATE into a date string recognizable by IMAP.
+While other search engines can interpret partially-qualified
+dates such as a plain \"January\", IMAP requires an absolute
+date.
+
+DATE is a list of (dd mm yyyy), any element of which could be
+nil. Massage those numbers into the most recent past occurrence
+of whichever date elements are present."
+ (let ((now (decode-time (current-time))))
+ ;; Set nil values to 1, current-month, current-year, or else 1, 1,
+ ;; current-year, depending on what we think the user meant.
+ (unless (seq-elt date 1)
+ (setf (seq-elt date 1)
+ (if (seq-elt date 0)
+ (seq-elt now 4)
+ 1)))
+ (unless (seq-elt date 0)
+ (setf (seq-elt date 0) 1))
+ (unless (seq-elt date 2)
+ (setf (seq-elt date 2)
+ (seq-elt now 5)))
+ ;; Fiddle with the date until it's in the past. There
+ ;; must be a way to combine all these steps.
+ (unless (< (seq-elt date 2)
+ (seq-elt now 5))
+ (when (< (seq-elt now 3)
+ (seq-elt date 0))
+ (cl-decf (seq-elt date 1)))
+ (cond ((zerop (seq-elt date 1))
+ (setf (seq-elt date 1) 1)
+ (cl-decf (seq-elt date 2)))
+ ((< (seq-elt now 4)
+ (seq-elt date 1))
+ (cl-decf (seq-elt date 2))))))
+ (format-time-string "%e-%b-%Y" (apply #'encode-time
+ (append '(0 0 0)
+ date))))
+
+(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
+ (str string))
+ (with-slots (literal-plus) engine
+ ;; If string is non-ASCII...
+ (if (null (= (length str)
+ (string-bytes str)))
+ ;; If LITERAL+ is available, use it and force UTF-8.
+ (if literal-plus
+ (format "{%d+}\n%s"
+ (string-bytes str)
+ (encode-coding-string str 'utf-8))
+ ;; Otherwise, if the user hasn't already quoted the string,
+ ;; quote it for them.
+ (if (string-prefix-p "\"" str)
+ str
+ (format "\"%s\"" str)))
+ str)))
+
+(defun gnus-search-imap-handle-flag (flag)
+ "Make sure string FLAG is something IMAP will recognize."
+ ;; What else? What about the KEYWORD search key?
+ (setq flag
+ (pcase flag
+ ("flag" "flagged")
+ ("read" "seen")
+ (_ flag)))
+ (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
+ (upcase flag)
+ ""))
+
+;;; Methods for the indexed search engines.
+
+;; First, some common methods.
+
+(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups)
+ "Parse the results of ENGINE's query against SERVER in GROUPS.
+Locally-indexed search engines return results as a list of
+filenames, sometimes with additional information. Returns a list
+of viable results, in the form of a list of [group article score]
+vectors.")
+
+(cl-defgeneric gnus-search-index-extract (engine)
+ "Extract a single article result from the current buffer.
+Returns a list of two values: a file name, and a relevancy score.
+Advances point to the beginning of the next result.")
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-indexed)
+ server query groups)
+ "Run QUERY against SERVER using ENGINE.
+This method is common to all indexed search engines.
+
+Returns a list of [group article score] vectors."
+
+ (save-excursion
+ (let* ((qstring (gnus-search-make-query-string engine query))
+ (program (slot-value engine 'program))
+ (buffer (slot-value engine 'proc-buffer))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ proc exitstatus)
+ (set-buffer buffer)
+ (erase-buffer)
+
+ (if groups
+ (message "Doing %s query on %s..." program groups)
+ (message "Doing %s query..." program))
+ (setq proc (apply #'start-process (format "search-%s" server)
+ buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (setq exitstatus (process-exit-status proc))
+ (if (zerop exitstatus)
+ ;; The search results have been put into the current buffer;
+ ;; `parse-output' finds them there and returns the article
+ ;; list.
+ (gnus-search-indexed-parse-output engine server query groups)
+ (nnheader-report 'search "%s error: %s" program exitstatus)
+ ;; Failure reason is in this buffer, show it if the user
+ ;; wants it.
+ (when (> gnus-verbose 6)
+ (display-buffer buffer))
+ nil))))
+
+(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
+ server query &optional groups)
+ (let ((prefix (slot-value engine 'prefix))
+ (group-regexp (when groups
+ (regexp-opt
+ (mapcar
+ (lambda (x) (gnus-group-real-name x))
+ groups))))
+ artlist vectors article group)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
+ (when (and (file-readable-p f-name)
+ (null (file-directory-p f-name))
+ (or (null groups)
+ (and (gnus-search-single-p query)
+ (alist-get 'thread query))
+ (string-match-p group-regexp f-name)))
+ (push (list f-name score) artlist))))
+ ;; Are we running an additional grep query?
+ (when-let ((grep-reg (alist-get 'grep query)))
+ (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
+ ;; Turn (file-name score) into [group article score].
+ (pcase-dolist (`(,f-name ,score) artlist)
+ (setq article (file-name-nondirectory f-name))
+ ;; Remove prefix.
+ (when (and prefix
+ (file-name-absolute-p prefix)
+ (string-match (concat "^"
+ (file-name-as-directory prefix))
+ f-name))
+ (setq group (replace-match "" t t (file-name-directory f-name))))
+ ;; Break the directory name down until it's something that
+ ;; (probably) can be used as a group name.
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "^[./\\]" ""
+ group nil t)
+ nil t)
+ nil t))
+
+ (push (vector (gnus-group-full-name group server)
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-match ":" article))
+ group nil))
+ (if (numberp score)
+ score
+ (string-to-number score)))
+ vectors))
+ vectors))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
+ "Base implementation treats the whole line as a filename, and
+fudges a relevancy score of 100."
+ (prog1
+ (list (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ 100)
+ (forward-line 1)))
+
+;; Swish++
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Untested and likely wrong.
+ ((and (stringp (cdr expr))
+ (string-prefix-p "(" (cdr expr)))
+ (format "%s = %s" (car expr) (gnus-search-transform
+ engine
+ (gnus-search-parse-query (cdr expr)))))
+ (t (format "%s = %s" (car expr) (cdr expr)))))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish++)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (config-file switches) engine
+ `("--config-file" ,config-file
+ ,@switches
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish++))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
+ (list (match-string 2)
+ (match-string 1))))
+
+;; Swish-e
+
+;; I didn't do the query transformation for Swish-e, because the
+;; program seems no longer to exist.
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish-e)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (index-files switches) engine
+ `("-f" ,@index-files
+ ,@switches
+ "-w"
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish-e))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
+ (list (match-string 3)
+ (match-string 1))))
+
+;; Namazu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-namazu)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'body)
+ (cadr expr))
+ ;; I have no idea which fields namazu can handle. Just do these
+ ;; for now.
+ ((memq (car expr) '(subject from to))
+ (format "+%s:%s" (car expr) (cdr expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eq (car expr) 'id)
+ (format "+message-id:%s" (cdr expr)))
+ (t (ignore-errors (cl-call-next-method)))))
+
+;; I can't tell if this is actually necessary.
+(cl-defmethod gnus-search-run-search :around ((_e gnus-search-namazu)
+ _server _query _groups)
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "LC_MESSAGES" "C")
+ (cl-call-next-method)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-namazu)
+ (qstring string)
+ query &optional _groups)
+ (let ((max (alist-get 'limit query)))
+ (with-slots (switches index-dir) engine
+ (append
+ (list "-q" ; don't be verbose
+ "-a" ; show all matches
+ "-s") ; use short format
+ (when max (list (format "--max=%d" max)))
+ switches
+ (list qstring index-dir)))))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-namazu))
+ "Extract a single message result for Namazu.
+Namazu provides a little more information, for instance a score."
+
+ (when (re-search-forward
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ nil t)
+ (list (match-string 4)
+ (match-string 3))))
+
+;;; Notmuch interface
+
+(cl-defmethod gnus-search-transform ((_engine gnus-search-notmuch)
+ (_query null))
+ "*")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr list))
+ ;; Swap keywords as necessary.
+ (cl-case (car expr)
+ (sender (setcar expr 'from))
+ ;; Notmuch's "to" is already equivalent to our "recipient".
+ (recipient (setcar expr 'to))
+ (mark (setcar expr 'tag)))
+ ;; Then actually format the results.
+ (cl-flet ((notmuch-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))
+ (`(,d ,m nil)
+ (format "%02d-%02d" d m))
+ (`(nil ,m ,y)
+ (format "%02d-%d" m y))
+ (`(,d ,m ,y)
+ (format "%d/%d/%d" m d y))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eql (car expr) 'body)
+ (cdr expr))
+ ((memq (car expr) '(from to subject attachment mimetype tag id
+ thread folder path lastmod query property))
+ ;; Notmuch requires message-id with no angle brackets.
+ (when (eql (car expr) 'id)
+ (setcdr
+ expr (replace-regexp-in-string "\\`<\\|>\\'" "" (cdr expr))))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ ;; Notmuch can only handle trailing asterisk
+ ;; wildcards, so strip leading asterisks.
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (notmuch-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch)
+ server query groups)
+ "Handle notmuch's thread-search routine."
+ ;; Notmuch allows for searching threads, but only using its own
+ ;; thread ids. That means a thread search is a \"double-bounce\":
+ ;; once to find the relevant thread ids, and again to find the
+ ;; actual messages. This method performs the first \"bounce\".
+ (if (alist-get 'thread query)
+ (with-slots (program proc-buffer) engine
+ (let* ((qstring
+ (gnus-search-make-query-string engine query))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ thread-ids proc)
+ (set-buffer proc-buffer)
+ (erase-buffer)
+ (setq proc (apply #'start-process (format "search-%s" server)
+ proc-buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
+ (push (match-string 1) thread-ids))
+ (cl-call-next-method
+ engine server
+ ;; Completely replace the query with our new thread-based one.
+ (mapconcat (lambda (thrd) (concat "thread:" thrd))
+ thread-ids " or ")
+ nil)))
+ (cl-call-next-method engine server query groups)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch)
+ (qstring string)
+ query &optional _groups)
+ ;; Theoretically we could use the GROUPS parameter to pass a
+ ;; --folder switch to notmuch, but I'm not confident of getting the
+ ;; format right.
+ (let ((limit (alist-get 'limit query))
+ (thread (alist-get 'thread query)))
+ (with-slots (switches config-file) engine
+ `(,(format "--config=%s" config-file)
+ "search"
+ ,(if thread
+ "--output=threads"
+ "--output=files")
+ "--duplicate=1" ; I have found this necessary, I don't know why.
+ ,@switches
+ ,(if limit (format "--limit=%d" limit) "")
+ ,qstring
+ ))))
+
+;;; Mairix interface
+
+;; See the Gnus manual for why mairix searching is a bit weird.
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-mairix)
+ (query list))
+ "Transform QUERY for a Mairix engine.
+Because Mairix doesn't accept parenthesized expressions, nor
+\"or\" statements between different keys, results may differ from
+other engines. We unpeel parenthesized expressions, and just
+cross our fingers for the rest of it."
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (if (consp (car-safe item))
+ (gnus-search-transform engine item)
+ (gnus-search-transform-expression engine item))))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head not)))
+ "Transform Mairix \"not\".
+Mairix negation requires a \"~\" preceding string search terms,
+and \"-\" before marks."
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (replace-regexp-in-string
+ ":"
+ (if (eql (caadr expr) 'mark)
+ ":-"
+ ":~")
+ next)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head or)))
+ "Handle Mairix \"or\" statement.
+Mairix only accepts \"or\" expressions on homogenous keys. We
+cast \"or\" expressions on heterogenous keys as \"and\", which
+isn't quite right, but it's the best we can do. For date keys,
+only keep one of the terms."
+ (let ((term1 (caadr expr))
+ (term2 (caaddr expr))
+ (val1 (gnus-search-transform-expression engine (nth 1 expr)))
+ (val2 (gnus-search-transform-expression engine (nth 2 expr))))
+ (cond
+ ((or (listp term1) (listp term2))
+ (concat val1 " " val2))
+ ((and (member (symbol-name term1) gnus-search-date-keys)
+ (member (symbol-name term2) gnus-search-date-keys))
+ (or val1 val2))
+ ((eql term1 term2)
+ (if (and val1 val2)
+ (format "%s/%s"
+ val1
+ (nth 1 (split-string val2 ":")))
+ (or val1 val2)))
+ (t (concat val1 " " val2)))))
+
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-mairix)
+ (expr (head mark)))
+ (gnus-search-mairix-handle-mark (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr list))
+ (let ((key (cl-case (car expr)
+ (sender "f")
+ (from "f")
+ (to "t")
+ (cc "c")
+ (subject "s")
+ (id "m")
+ (body "b")
+ (address "a")
+ (recipient "tc")
+ (text "bs")
+ (attachment "n")
+ (t nil))))
+ (cond
+ ((consp (car expr))
+ (gnus-search-transform engine expr))
+ ((member (symbol-name (car expr)) gnus-search-date-keys)
+ (gnus-search-mairix-handle-date expr))
+ ((memq (car expr) '(size smaller larger))
+ (gnus-search-mairix-handle-size expr))
+ ;; Drop regular expressions.
+ ((string-match-p "\\`/" (cdr expr))
+ nil)
+ ;; Turn parenthesized phrases into multiple word terms. Again,
+ ;; this isn't quite what the user is asking for, but better to
+ ;; return false positives.
+ ((and key (string-match-p "[[:blank:]]" (cdr expr)))
+ (mapconcat
+ (lambda (s) (format "%s:%s" key s))
+ (split-string (gnus-search-mairix-treat-string
+ (cdr expr)))
+ " "))
+ (key (format "%s:%s" key
+ (gnus-search-mairix-treat-string
+ (cdr expr))))
+ (t nil))))
+
+(defun gnus-search-mairix-treat-string (str)
+ "Treat string for wildcards.
+Mairix accepts trailing wildcards, but not leading. Also remove
+double quotes."
+ (replace-regexp-in-string
+ "\\`\\*\\|\"" ""
+ (replace-regexp-in-string "\\*\\'" "=" str)))
+
+(defun gnus-search-mairix-handle-size (expr)
+ "Format a mairix size search.
+Assume \"size\" key is equal to \"larger\"."
+ (format
+ (if (eql (car expr) 'smaller)
+ "z:-%s"
+ "z:%s-")
+ (cdr expr)))
+
+(defun gnus-search-mairix-handle-mark (expr)
+ "Format a mairix mark search."
+ (let ((mark
+ (pcase (cdr expr)
+ ("flag" "f")
+ ("read" "s")
+ ("seen" "s")
+ ("replied" "r")
+ (_ nil))))
+ (when mark
+ (format "F:%s" mark))))
+
+(defun gnus-search-mairix-handle-date (expr)
+ (let ((str
+ (pcase (cdr expr)
+ (`(nil ,m nil)
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%s%02d"
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)
+ d))
+ (`(nil ,m ,y)
+ (format "%d%s"
+ y (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)))
+ (`(,d ,m ,y)
+ (format "%d%02d%02d" y m d)))))
+ (format
+ (pcase (car expr)
+ ('date "d:%s")
+ ('since "d:%s-")
+ ('after "d:%s-")
+ ('before "d:-%s"))
+ str)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mairix)
+ (qstring string)
+ query &optional _groups)
+ (with-slots (switches config-file) engine
+ (append `("--rcfile" ,config-file "-r")
+ switches
+ (when (alist-get 'thread query) (list "-t"))
+ (list qstring))))
+
+;;; Find-grep interface
+
+(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
+ (_ list))
+ ;; Drop everything that isn't a plain string.
+ nil)
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-find-grep)
+ server query
+ &optional groups)
+ "Run find and grep to obtain matching articles."
+ (let* ((method (gnus-server-to-method server))
+ (sym (intern
+ (concat (symbol-name (car method)) "-directory")))
+ (directory (cadr (assoc sym (cddr method))))
+ (regexp (alist-get 'grep query))
+ (grep-options (slot-value engine 'grep-options))
+ (grouplist (or groups (gnus-search-get-active server)))
+ (buffer (slot-value engine 'proc-buffer)))
+ (unless directory
+ (error "No directory found in method specification of server %s"
+ server))
+ (apply
+ 'vconcat
+ (mapcar (lambda (x)
+ (let ((group x)
+ artlist)
+ (message "Searching %s using find-grep..."
+ (or group server))
+ (save-window-excursion
+ (set-buffer buffer)
+ (if (> gnus-verbose 6)
+ (pop-to-buffer (current-buffer)))
+ (cd directory) ; Using relative paths simplifies
+ ; postprocessing.
+ (let ((group
+ (if (not group)
+ "."
+ ;; Try accessing the group literally as
+ ;; well as interpreting dots as directory
+ ;; separators so the engine works with
+ ;; plain nnml as well as the Gnus Cache.
+ (let ((group (gnus-group-real-name group)))
+ ;; Replace cl-func find-if.
+ (if (file-directory-p group)
+ group
+ (if (file-directory-p
+ (setq group
+ (replace-regexp-in-string
+ "\\." "/"
+ group nil t)))
+ group))))))
+ (unless group
+ (error "Cannot locate directory for group"))
+ (save-excursion
+ (apply
+ 'call-process "find" nil t
+ "find" group "-maxdepth" "1" "-type" "f"
+ "-name" "[0-9]*" "-exec"
+ (slot-value engine 'grep-program)
+ `("-l" ,@(and grep-options
+ (split-string grep-options "\\s-" t))
+ "-e" ,regexp "{}" "+"))))
+
+ ;; Translate relative paths to group names.
+ (while (not (eobp))
+ (let* ((path (split-string
+ (buffer-substring
+ (point)
+ (line-end-position)) "/" t))
+ (art (string-to-number (car (last path)))))
+ (while (string= "." (car path))
+ (setq path (cdr path)))
+ (let ((group (mapconcat #'identity
+ (cl-subseq path 0 -1)
+ ".")))
+ (push
+ (vector (gnus-group-full-name group server) art 0)
+ artlist))
+ (forward-line 1)))
+ (message "Searching %s using find-grep...done"
+ (or group server))
+ artlist)))
+ grouplist))))
+
+(declare-function mm-url-insert "mm-url" (url &optional follow-refresh))
+(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs))
+
+;; gmane interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-gmane)
+ srv query &optional groups)
+ "Run a search against a gmane back-end server."
+ (let* ((case-fold-search t)
+ (groupspec (mapconcat
+ (lambda (x)
+ (if (string-match-p "gmane" x)
+ (format "group:%s" (gnus-group-short-name x))
+ (error "Can't search non-gmane groups: %s" x)))
+ groups " "))
+ (buffer (slot-value engine 'proc-buffer))
+ (search (concat (gnus-search-make-query-string engine query)
+ " "
+ groupspec))
+ (gnus-inhibit-demon t)
+ artlist)
+ (require 'mm-url)
+ (with-current-buffer buffer
+ (erase-buffer)
+ (mm-url-insert
+ (concat
+ "http://search.gmane.org/nov.php"
+ "?"
+ (mm-url-encode-www-form-urlencoded
+ `(("query" . ,search)
+ ("HITSPERPAGE" . "999")))))
+ (set-buffer-multibyte t)
+ (decode-coding-region (point-min) (point-max) 'utf-8)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (not (eobp))
+ (unless (or (eolp) (looking-at "\x0d"))
+ (let ((header (nnheader-parse-nov)))
+ (let ((xref (mail-header-xref header))
+ (xscore (string-to-number (cdr (assoc 'X-Score
+ (mail-header-extra header))))))
+ (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
+ (push
+ (vector
+ (gnus-group-prefixed-name (match-string 1 xref) srv)
+ (string-to-number (match-string 2 xref)) xscore)
+ artlist)))))
+ (forward-line 1)))
+ (apply #'vector (nreverse (delete-dups artlist)))))
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head near)))
+ nil)
+
+;; Can Gmane handle OR or NOT keywords?
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head or)))
+ nil)
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head not)))
+ nil)
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (expr list))
+ "The only keyword value gmane can handle is author, ie from."
+ (cond
+ ((memq (car expr) '(from sender author address))
+ (format "author:%s" (cdr expr)))
+ ((eql (car expr) 'body)
+ (cdr expr))))
+
+;;; Util Code:
+
+(defun gnus-search-run-query (specs)
+ "Invoke appropriate search engine function."
+ ;; For now, run the searches synchronously. At some point each
+ ;; search can be run in its own thread, allowing concurrent searches
+ ;; of multiple backends. At present this causes problems when
+ ;; multiple IMAP servers are searched at the same time, apparently
+ ;; because the `nntp-server-buffer' variable is getting clobbered,
+ ;; or something. Anyway, that's the reason for the `mapc'.
+ (let ((results [])
+ (prepared-query (gnus-search-prepare-query
+ (alist-get 'search-query-spec specs))))
+ (mapc
+ (pcase-lambda (`(,server . ,groups))
+ (let ((search-engine (gnus-search-server-to-engine server)))
+ (setq results
+ (vconcat
+ (gnus-search-run-search
+ search-engine server prepared-query groups)
+ results))))
+ (alist-get 'search-group-spec specs))
+ results))
+
+(defun gnus-search-prepare-query (query-spec)
+ "Accept a search query in raw format, and prepare it.
+QUERY-SPEC is an alist produced by functions such as
+`gnus-group-make-search-group', and contains at least a 'query
+key, and possibly some meta keys. This function extracts any
+additional meta keys from the 'query string, and parses the
+remaining string, then adds all that to the top-level spec."
+ (let ((query (alist-get 'query query-spec))
+ val)
+ (when (stringp query)
+ ;; Look for these meta keys:
+ (while (string-match
+ "\\(thread\\|grep\\|limit\\|raw\\):\\([^ ]+\\)"
+ query)
+ (setq val (match-string 2 query))
+ (setf (alist-get (intern (match-string 1 query)) query-spec)
+ ;; This is stupid.
+ (cond
+ ((equal val "t"))
+ ((null (zerop (string-to-number val)))
+ (string-to-number val))
+ (t val)))
+ (setq query
+ (string-trim (replace-match "" t t query 0)))
+ (setf (alist-get 'query query-spec) query)))
+ (when gnus-search-use-parsed-queries
+ (setf (alist-get 'parsed-query query-spec)
+ (gnus-search-parse-query query)))
+ query-spec))
+
+;; This should be done once at Gnus startup time, when the servers are
+;; first opened, and the resulting engine instance attached to the
+;; server.
+(defun gnus-search-server-to-engine (srv)
+ (let* ((method (gnus-server-to-method srv))
+ (server
+ (or (assoc 'gnus-search-engine (cddr method))
+ (assoc (car method) gnus-search-default-engines)
+ (when-let ((old (assoc 'nnir-search-engine
+ (cddr method))))
+ (nnheader-message
+ 8 "\"nnir-search-engine\" is no longer a valid parameter")
+ (pcase old
+ ('notmuch 'gnus-search-notmuch)
+ ('namazu 'gnus-search-notmuch)
+ ('find-grep 'gnus-search-find-grep)))))
+ (inst
+ (cond
+ ((null server) nil)
+ ((eieio-object-p (cadr server))
+ (cadr server))
+ ((class-p (cadr server))
+ (make-instance (cadr server)))
+ (t nil))))
+ (if inst
+ (when (cddr server)
+ (pcase-dolist (`(,key ,value) (cddr server))
+ (condition-case nil
+ (setf (slot-value inst key) value)
+ ((invalid-slot-name invalid-slot-type)
+ (nnheader-message
+ 5 "Invalid search engine parameter: (%s %s)"
+ key value)))))
+ (nnheader-message 5 "No search engine defined for %s" srv))
+ inst))
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-search-thread (header)
+ "Make an nnselect group based on the thread containing the article
+header. The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server
+ (cl-pushnew (list registry-server) server :test #'equal))
+ (gnus-group-make-search-group nil (list
+ (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+(defun gnus-search-get-active (srv)
+ (let ((method (gnus-server-to-method srv))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null gnus-search-ignored-newsgroups)
+ (string= gnus-search-ignored-newsgroups ""))
+ (delete-matching-lines gnus-search-ignored-newsgroups))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
+ groups))
+ (forward-line)))))
+ groups))
+
+(defvar gnus-search-minibuffer-map
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km minibuffer-local-map)
+ (define-key km (kbd "SPC") #'self-insert-command)
+ (define-key km (kbd "TAB") #'gnus-search-complete-key)
+ km))
+
+(defun gnus-search-complete-key ()
+ "Complete a search key at point.
+Used when reading a search query from the minibuffer."
+ (interactive)
+ (when (completion-in-region
+ (save-excursion
+ (if (re-search-backward " " (minibuffer-prompt-end) t)
+ (1+ (point))
+ (minibuffer-prompt-end)))
+ (point) gnus-search-expandable-keys)
+ (insert ":")))
+
+(defun gnus-search-make-spec (arg)
+ (list (cons 'query
+ (read-from-minibuffer
+ "Query: " nil gnus-search-minibuffer-map
+ nil 'gnus-search-history))
+ (cons 'raw arg)))
+
+(provide 'gnus-search)
+;;; gnus-search.el ends here
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 21206b683c..ce2e99de05 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -36,10 +36,10 @@
;; sorting. Most functions will just chose a fixed number, such as
;; 100, for this score.
-;; For example the search function `nnir-run-query' applied to
-;; arguments specifying a search query (see "nnir.el") can be used to
-;; return a list of articles from a search. Or the function can be the
-;; identity and the args a vector of articles.
+;; For example the search function `gnus-search-run-query' applied to
+;; arguments specifying a search query (see "gnus-search.el") can be
+;; used to return a list of articles from a search. Or the function
+;; can be the identity and the args a vector of articles.
;;; Code:
@@ -47,7 +47,7 @@
;;; Setup:
(require 'gnus-art)
-(require 'nnir)
+(require 'gnus-search)
(eval-when-compile (require 'cl-lib))
@@ -372,25 +372,25 @@ nnselect-request-article
;; find the servers for a pseudo-article
(if (eq 'nnselect (car (gnus-server-to-method server)))
(with-current-buffer gnus-summary-buffer
- (let ((thread (gnus-id-to-thread article)))
+ (let ((thread (gnus-id-to-thread article)))
(when thread
(mapc
- #'(lambda (x)
- (when (and x (> x 0))
- (cl-pushnew
- (list
- (gnus-method-to-server
- (gnus-find-method-for-group
- (nnselect-article-group x)))) servers :test 'equal)))
+ (lambda (x)
+ (when (and x (> x 0))
+ (cl-pushnew
+ (list
+ (gnus-method-to-server
+ (gnus-find-method-for-group
+ (nnselect-article-group x)))) servers :test 'equal)))
(gnus-articles-in-thread thread)))))
(setq servers (list (list server))))
(setq artlist
- (nnir-run-query
+ (gnus-search-run-query
(list
- (cons 'nnir-query-spec
- (list (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "") (cons 'shortcut t)))
- (cons 'nnir-group-spec servers))))
+ (cons 'search-query-spec
+ (list (cons 'query `((id . ,article)))
+ (cons 'criteria "") (cons 'shortcut t)))
+ (cons 'search-group-spec servers))))
(unless (zerop (nnselect-artlist-length artlist))
(setq
group-art
@@ -603,26 +603,35 @@ nnselect-request-thread
(cl-some #'(lambda (x)
(when (and x (> x 0)) x))
(gnus-articles-in-thread thread)))))))))
- ;; Check if we are dealing with an imap backend.
- (if (eq 'nnimap
- (car (gnus-find-method-for-group artgroup)))
+ ;; Check if search-based thread referral is permitted, and
+ ;; available.
+ (if (and gnus-refer-thread-use-search
+ (gnus-search-server-to-engine
+ (gnus-method-to-server
+ (gnus-find-method-for-group artgroup))))
;; If so we perform the query, massage the result, and return
;; the new headers back to the caller to incorporate into the
;; current summary buffer.
(let* ((group-spec
(list (delq nil (list
(or server (gnus-group-server artgroup))
- (unless gnus-refer-thread-use-search
+ (unless gnus-refer-thread-use-search
artgroup)))))
+ (ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
(query-spec
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(last (nnselect-artlist-length gnus-newsgroup-selection))
(first (1+ last))
(new-nnselect-artlist
- (nnir-run-query
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))
old-arts seq
headers)
(mapc
@@ -670,7 +679,7 @@ nnselect-request-thread
group
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
headers)
- ;; If not an imap backend just warp to the original article
+ ;; If we can't or won't use search, just warp to the original
;; group and punt back to gnus-summary-refer-thread.
(and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
@@ -768,9 +777,15 @@ nnselect-search-thread
The current server will be searched. If the registry is
installed, the server that the registry reports the current
article came from is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(server
(list (list (gnus-method-to-server
(gnus-find-method-for-group gnus-newsgroup-name)))))
@@ -794,10 +809,10 @@ nnselect-search-thread
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))))
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))))
(cons 'nnselect-artlist nil)))
(gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
@@ -929,18 +944,18 @@ nnselect-push-info
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-(defun gnus-summary-make-search-group (nnir-extra-parms)
+(defun gnus-summary-make-search-group (no-parse)
"Search a group from the summary buffer.
-Pass NNIR-EXTRA-PARMS on to the search engine."
+Pass NO-PARSE on to the search engine."
(interactive "P")
(gnus-warp-to-article)
(let ((spec
(list
- (cons 'nnir-group-spec
+ (cons 'search-group-spec
(list (list
(gnus-group-server gnus-newsgroup-name)
gnus-newsgroup-name))))))
- (gnus-group-make-search-group nnir-extra-parms spec)))
+ (gnus-group-make-search-group no-parse spec)))
;; The end.
diff --git a/test/lisp/gnus/search-tests.el b/test/lisp/gnus/search-tests.el
new file mode 100644
index 0000000000..7c0a856900
--- /dev/null
+++ b/test/lisp/gnus/search-tests.el
@@ -0,0 +1,99 @@
+;;; gnus-search-tests.el --- Tests for Gnus' search routines -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for the search parsing, search engines, and their
+;; transformations.
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-search)
+
+(ert-deftest gnus-s-parse ()
+ "Test basic structural parsing."
+ (let ((pairs
+ '(("string" . ("string"))
+ ("from:john" . ((from . "john")))
+ ("here and there" . ("here" and "there"))
+ ("here or there" . ((or "here" "there")))
+ ("here (there or elsewhere)" . ("here" ((or "there" "elsewhere"))))
+ ("here not there" . ("here" (not "there")))
+ ("from:boss or not vacation" . ((or (from . "boss") (not "vacation")))))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-parse-query (car p)) (cdr p))))))
+
+(ert-deftest gnus-s-expand-keyword ()
+ "Test expansion of keywords"
+ (let ((gnus-search-expandable-keys
+ (default-value 'gnus-search-expandable-keys))
+ (pairs
+ '(("su" . "subject")
+ ("f" . "from")
+ ("co-f" . "contact-from"))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-expand-key (car p))
+ (cdr p))))
+ (should-error (gnus-search-query-expand-key "s")
+ :type 'gnus-search-parse-error)
+ (should-error (gnus-search-query-expand-key "c-f")
+ :type 'gnus-search-parse-error)))
+
+(ert-deftest gnus-s-parse-date ()
+ "Test parsing of date expressions."
+ (let ((rel-date (encode-time 0 0 0 15 4 2017))
+ (pairs
+ '(("January" . (nil 1 nil))
+ ("2017" . (nil nil 2017))
+ ("15" . (15 nil nil))
+ ("January 15" . (15 1 nil))
+ ("tuesday" . (11 4 2017))
+ ("1d" . (14 4 2017))
+ ("1w" . (8 4 2017)))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-parse-date (car p) rel-date)
+ (cdr p))))))
+
+(ert-deftest gnus-s-delimited-string ()
+ "Test proper functioning of `gnus-search-query-return-string'."
+ (with-temp-buffer
+ (insert "one\ntwo words\nthree \"words with quotes\"\n\"quotes at start\"\n/alternate \"quotes\"/\n(more bits)")
+ (goto-char (point-min))
+ (should (string= (gnus-search-query-return-string)
+ "one"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "two"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "three"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "\"")
+ "\"quotes at start\""))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "/")
+ "/alternate \"quotes\"/"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string ")" t)
+ "more bits"))))
+
+(provide 'gnus-search-tests)
+;;; search-tests.el ends here
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-10-15 16:47 bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus Eric Abrahamsen
@ 2020-10-16 5:08 ` Lars Ingebrigtsen
2020-10-16 15:49 ` Eric Abrahamsen
0 siblings, 1 reply; 14+ messages in thread
From: Lars Ingebrigtsen @ 2020-10-16 5:08 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 44016
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> - This patch doesn't remove the nnir.el library, though that's now
> obsolete. I think removing it could be problematic: it's not like
> declaring functions/variables obsolete, where we can let people down
> gently. I suspect plenty of code uses (require 'nnir), which will
> cause blowups. Renaming gnus-search.el to nnir.el doesn't make a lot
> of sense, though. I'm considering leaving the nnir.el file in there,
> but containing nothing but a warning.
Just move it to obsolete/.
--
(domestic pets only, the antidote for overdose, milk.)
bloggy blog: http://lars.ingebrigtsen.no
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-10-16 5:08 ` Lars Ingebrigtsen
@ 2020-10-16 15:49 ` Eric Abrahamsen
2020-11-01 5:32 ` Eric Abrahamsen
0 siblings, 1 reply; 14+ messages in thread
From: Eric Abrahamsen @ 2020-10-16 15:49 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 44016
On 10/16/20 07:08 AM, Lars Ingebrigtsen wrote:
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> - This patch doesn't remove the nnir.el library, though that's now
>> obsolete. I think removing it could be problematic: it's not like
>> declaring functions/variables obsolete, where we can let people down
>> gently. I suspect plenty of code uses (require 'nnir), which will
>> cause blowups. Renaming gnus-search.el to nnir.el doesn't make a lot
>> of sense, though. I'm considering leaving the nnir.el file in there,
>> but containing nothing but a warning.
>
> Just move it to obsolete/.
Oh, of course -- thanks.
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-10-16 15:49 ` Eric Abrahamsen
@ 2020-11-01 5:32 ` Eric Abrahamsen
2020-11-01 18:10 ` Basil L. Contovounesios
2020-11-01 21:38 ` Eric Abrahamsen
0 siblings, 2 replies; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-01 5:32 UTC (permalink / raw)
To: Lars Ingebrigtsen; +Cc: 44016
[-- Attachment #1: Type: text/plain, Size: 1278 bytes --]
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> On 10/16/20 07:08 AM, Lars Ingebrigtsen wrote:
>> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>>
>>> - This patch doesn't remove the nnir.el library, though that's now
>>> obsolete. I think removing it could be problematic: it's not like
>>> declaring functions/variables obsolete, where we can let people down
>>> gently. I suspect plenty of code uses (require 'nnir), which will
>>> cause blowups. Renaming gnus-search.el to nnir.el doesn't make a lot
>>> of sense, though. I'm considering leaving the nnir.el file in there,
>>> but containing nothing but a warning.
>>
>> Just move it to obsolete/.
>
> Oh, of course -- thanks.
Finally done! I think. Most of the final work was writing the docs.
So there's documentation, nnir.el is in obsolete/, and I've defaulted
`gnus-search-use-parsed-queries' to nil, so that no one is surprised.
I also implemented a search engine for gmane, then removed it in one
separate commit, in case one fine day we get that back again it will be
easy to revert the removal.
I think it's ready to go! I'm sure there are bugs but it shouldn't be
too disruptive, since there's a big Turn It On switch people will have
to flip, and they can just turn it off again.
Eric
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0003-Remove-gmane-search-engine.patch --]
[-- Type: text/x-patch, Size: 4027 bytes --]
From 0aefebf3f45cb14c222c8b69412ae2aa8b1ec881 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Sat, 31 Oct 2020 18:30:57 -0700
Subject: [PATCH 3/3] Remove gmane search engine
Remove the gnus-search-gmane class and all associated methods. If
search functionality is ever resurrected, then revert this commit.
* lisp/gnus/gnus-search.el: Delete code, and remove from default value
of `gnus-search-default-engines'.
---
lisp/gnus/gnus-search.el | 77 +---------------------------------------
1 file changed, 1 insertion(+), 76 deletions(-)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
index 50007da4d3..bbfc793f54 100644
--- a/lisp/gnus/gnus-search.el
+++ b/lisp/gnus/gnus-search.el
@@ -857,9 +857,6 @@ gnus-search-find-grep
gnus-search-grep)
nil)
-(defclass gnus-search-gmane (gnus-search-engine gnus-search-process)
- nil)
-
;;; The "indexed" search engine. These are engines that use an
;;; external program, with indexes kept on disk, to search messages
;;; usually kept in some local directory. The three common slots are
@@ -1002,8 +999,7 @@ 'gnus-search-notmuch
(define-obsolete-variable-alias 'nnir-method-default-engines
'gnus-search-default-engines "28.1")
-(defcustom gnus-search-default-engines '((nnimap gnus-search-imap)
- (nntp gnus-search-gmane))
+(defcustom gnus-search-default-engines '((nnimap gnus-search-imap))
"Alist of default search engines keyed by server method."
:version "26.1"
:group 'gnus-search
@@ -1953,77 +1949,6 @@ gnus-search-run-search
artlist)))
grouplist))))
-(declare-function mm-url-insert "mm-url" (url &optional follow-refresh))
-(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs))
-
-;; gmane interface
-(cl-defmethod gnus-search-run-search ((engine gnus-search-gmane)
- srv query &optional groups)
- "Run a search against a gmane back-end server."
- (let* ((case-fold-search t)
- (groupspec (mapconcat
- (lambda (x)
- (if (string-match-p "gmane" x)
- (format "group:%s" (gnus-group-short-name x))
- (error "Can't search non-gmane groups: %s" x)))
- groups " "))
- (buffer (slot-value engine 'proc-buffer))
- (search (concat (gnus-search-make-query-string engine query)
- " "
- groupspec))
- (gnus-inhibit-demon t)
- artlist)
- (require 'mm-url)
- (with-current-buffer buffer
- (erase-buffer)
- (mm-url-insert
- (concat
- "http://search.gmane.org/nov.php"
- "?"
- (mm-url-encode-www-form-urlencoded
- `(("query" . ,search)
- ("HITSPERPAGE" . "999")))))
- (set-buffer-multibyte t)
- (decode-coding-region (point-min) (point-max) 'utf-8)
- (goto-char (point-min))
- (forward-line 1)
- (while (not (eobp))
- (unless (or (eolp) (looking-at "\x0d"))
- (let ((header (nnheader-parse-nov)))
- (let ((xref (mail-header-xref header))
- (xscore (string-to-number (cdr (assoc 'X-Score
- (mail-header-extra header))))))
- (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
- (push
- (vector
- (gnus-group-prefixed-name (match-string 1 xref) srv)
- (string-to-number (match-string 2 xref)) xscore)
- artlist)))))
- (forward-line 1)))
- (apply #'vector (nreverse (delete-dups artlist)))))
-
-(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
- (_expr (head near)))
- nil)
-
-;; Can Gmane handle OR or NOT keywords?
-(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
- (_expr (head or)))
- nil)
-
-(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
- (_expr (head not)))
- nil)
-
-(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
- (expr list))
- "The only keyword value gmane can handle is author, ie from."
- (cond
- ((memq (car expr) '(from sender author address))
- (format "author:%s" (cdr expr)))
- ((eql (car expr) 'body)
- (cdr expr))))
-
;;; Util Code:
(defun gnus-search-run-query (specs)
--
2.29.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Move-nnir.el-to-lisp-obsolete.patch --]
[-- Type: text/x-patch, Size: 586 bytes --]
From ec3c627752dead36968236db77872be75c33efc5 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Fri, 16 Oct 2020 09:34:06 -0700
Subject: [PATCH 2/3] Move nnir.el to lisp/obsolete
* lisp/obsolete/nnir.el: This is no longer used, but users might still
be requiring it.
---
lisp/{gnus => obsolete}/nnir.el | 0
1 file changed, 0 insertions(+), 0 deletions(-)
rename lisp/{gnus => obsolete}/nnir.el (100%)
diff --git a/lisp/gnus/nnir.el b/lisp/obsolete/nnir.el
similarity index 100%
rename from lisp/gnus/nnir.el
rename to lisp/obsolete/nnir.el
--
2.29.1
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0001-New-gnus-search-library.patch --]
[-- Type: text/x-patch, Size: 123250 bytes --]
From 68fe9e966e9c70318e35f82532a5e95d74c1faa5 Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Wed, 14 Oct 2020 21:39:46 -0700
Subject: [PATCH 1/3] New gnus-search library
This library provides a fundamental reworking of the search
functionality previously found in nnir.el. It uses class-based search
engines to interface with external searching facilities, and a parsed
search query syntax that can search multiple engines.
* lisp/gnus/gnus-search.el: New library containing search
functionality for Gnus.
* doc/misc/gnus.texi: Document.
* lisp/gnus/gnus-group.el (gnus-group-make-search-group,
gnus-group-read-ephemeral-search-group): Remove references to nnir,
change meaning of prefix argument, change values of nnselect-function
and nnselect-args.
* lisp/gnus/nnselect.el: Replace references to nnir
(nnselect-request-article): Use gnus-search functions, and search
criteria.
(nnselect-request-thread, nnselect-search-thread): Use gnus-search
thread search.
(gnus-summary-make-search-group): Switch to use gnus-search function
and arguments.
* test/lisp/gnus/search-tests.el: Tests for new functionality.
---
doc/misc/gnus.texi | 604 ++++-----
lisp/gnus/gnus-group.el | 68 +-
lisp/gnus/gnus-search.el | 2230 ++++++++++++++++++++++++++++++++
lisp/gnus/nnselect.el | 91 +-
test/lisp/gnus/search-tests.el | 99 ++
5 files changed, 2679 insertions(+), 413 deletions(-)
create mode 100644 lisp/gnus/gnus-search.el
create mode 100644 test/lisp/gnus/search-tests.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 69ac05d5aa..0c5910074a 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -795,19 +795,11 @@ Top
Searching
-* nnir:: Searching with various engines.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: Creating search groups.
+* Search Queries:: Gnus' built-in search syntax.
* nnmairix:: Searching with Mairix.
-nnir
-
-* What is nnir?:: What does nnir do.
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up nnir.
-
-Setting up nnir
-
-* Associating Engines:: How to associate engines.
-
Various
* Process/Prefix:: A convention used by many treatment commands.
@@ -17919,12 +17911,11 @@ Selection Groups
@lisp
(nnselect-specs
- (nnselect-function . nnir-run-query)
+ (nnselect-function . gnus-search-run-query)
(nnselect-args
- (nnir-query-spec
- (query . "FLAGGED")
- (criteria . ""))
- (nnir-group-spec
+ (search-query-spec
+ (query . "mark:flag"))
+ (search-group-spec
("nnimap:home")
("nnimap:work"))))
@end lisp
@@ -17945,9 +17936,8 @@ Selection Groups
(days-to-time (car args)))))
(cons 'criteria "")))
(group-spec (cadr args)))
- (nnir-run-query (cons 'nnir-specs
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))))
+ (gnus-search-run-query (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))))
@end lisp
Then the following @code{nnselect-specs}:
@@ -17970,18 +17960,13 @@ Selection Groups
A refresh can always be invoked manually through
@code{gnus-group-get-new-news-this-group}.
-The nnir interface (@pxref{nnir}) includes engines for searching a
-variety of backends. While the details of each search engine vary,
-the result of an nnir search is always a vector of the sort used by
-the nnselect method, and the results of nnir queries are usually
-viewed using an nnselect group. Indeed the standard search function
-@code{gnus-group-read-ephemeral-search-group} just creates an
-ephemeral nnselect group with the appropriate nnir query as the
-@code{nnselect-specs}. nnir originally included both the search
-engines and the glue to connect search results to gnus. Over time
-this glue evolved into the nnselect method. The two had a mostly
-amicable parting so that nnselect could pursue its dream of becoming a
-fully functioning backend, but occasional conflicts may still linger.
+Gnus includes engines for searching a variety of backends. While the
+details of each search engine vary, the result of a search is always a
+vector of the sort used by the nnselect method, and the results of
+queries are usually viewed using an nnselect group. Indeed the
+standard search function @code{gnus-group-read-ephemeral-search-group}
+just creates an ephemeral nnselect group with the appropriate search
+query as the @code{nnselect-specs}.
@node Combined Groups
@subsection Combined Groups
@@ -21445,9 +21430,6 @@ Searching
@chapter Searching
@cindex searching
-FIXME: A brief comparison of nnir, nnmairix, contrib/gnus-namazu would
-be nice.
-
Gnus has various ways of finding articles that match certain criteria
(from a particular author, on a certain subject, etc.). The simplest
method is to enter a group and then either "limit" the summary buffer
@@ -21455,50 +21437,168 @@ Searching
or searching through messages in the summary buffer (@pxref{Searching
for Articles}).
-Limiting commands and summary buffer searching work on subsets of the
-articles already fetched from the servers, and these commands won't
-query the server for additional articles. While simple, these methods
-are therefore inadequate if the desired articles span multiple groups,
-or if the group is so large that fetching all articles is impractical.
-Many backends (such as imap, notmuch, namazu, etc.) provide their own
-facilities to search for articles directly on the server and Gnus can
-take advantage of these methods. This chapter describes tools for
-searching groups and servers for articles matching a query.
+Limiting commands and summary buffer searching work on articles
+already fetched from the servers, and these commands won't query the
+server for additional articles. While simple, these methods are
+therefore inadequate if the desired articles span multiple groups, or
+if the group is so large that fetching all articles is impractical.
+
+It's possible to search a backend more thoroughly using an associated
+search engine. Some backends come with their own search engine: IMAP
+servers, for instance, do their own searching. Other backends, for
+example a local @code{nnmaildir} installation, might require the user
+to manually set up some sort of search indexing. Default associations
+between backends and engines can be defined in
+@code{gnus-search-default-engines}, and engines can also be defined on
+a per-backend basis (@xref{Search Engines}).
+
+Once the search engines are set up, you can search for messages in
+groups from one or more backends, and show the results in a group.
+The groups that hold search results are created on the nnselect
+backend, and can be either ephemeral or persistent (@xref{Creating
+Search Groups}).
+
+@vindex: gnus-search-use-parsed-queries
+
+Search queries can be specified one of two ways: either using the
+syntax of the engine responsible for the group you're searching, or
+using Gnus' generalized search syntax. Set the option
+@code{gnus-search-use-parsed-queries} to a non-nil value to used the
+generalized syntax. The advantage of this syntax is that, if you have
+multiple backends indexed by different engines, you don't need to
+remember which one you're searching -- it's also possible to issue the
+same query against multiple groups, indexed by different engines, at
+the same time. It also provides a few other conveniences including
+relative date parsing and tie-ins into other Emacs packages. For
+details on Gnus' query language, @xref{Search Queries}.
@menu
-* nnir:: Searching with various engines.
-* nnmairix:: Searching with Mairix.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: How and where.
+* Search Queries:: Gnus' built-in search syntax.
+* nnmairix:: Searching with Mairix.
@end menu
-@node nnir
-@section nnir
-@cindex nnir
+@node Search Engines
+@section Search Engines
+@cindex search engines
+@cindex configuring search
+
+In order to search for messages from any given server, that server
+must have a search engine associated with it. IMAP servers do their
+own searching (theoretically it is possible to use a different engine
+to search an IMAP store, but we don't recommend it), but in all other
+cases the user will have to manually specific an engine to use. This
+can be done at two different levels: generally by server type, or on a
+per-server basis.
+
+@vindex gnus-search-default-engines
+The option @code{gnus-search-default-engines} assigns search engines
+by server type. Its value is an alist mapping symbols indicating a
+server type (e.g. @code{nnmaildir} or @code{nnml}) to symbols
+indicating a search engine class. The built-in search engine symbols
+are:
-This section describes how to use @code{nnir} to search for articles
-within gnus.
+@itemize
+@item
+@code{gnus-search-imap}
-@menu
-* What is nnir?:: What does @code{nnir} do?
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up @code{nnir}.
-@end menu
+@item
+@code{gnus-search-find-grep}
-@node What is nnir?
-@subsection What is nnir?
+@item
+@code{gnus-search-notmuch}
-@code{nnir} is a Gnus interface to a number of tools for searching
-through mail and news repositories. Different backends (like
-@code{nnimap} and @code{nntp}) work with different tools (called
-@dfn{engines} in @code{nnir} lingo), but all use the same basic search
-interface.
+@item
+@code{gnus-search-swish-e}
+
+@item
+@code{gnus-search-swish++}
+
+@item
+@code{gnus-search-mairix}
-The @code{nnimap} search engine should work with no configuration.
-Other engines may require a local index that needs to be created and
-maintained outside of Gnus.
+@item
+@code{gnus-search-namazu}
+@end itemize
+
+If you need more granularity, you can specify a search engine in the
+server definition, using the @code{gnus-search-engine} key, whether
+that be in your @file{.gnus.el} config file, or through the server
+buffer. That might look like:
+@example
+'(nnmaildir "My Mail"
+ (directory "/home/user/.mail")
+ (gnus-search-engine gnus-search-notmuch
+ (config-file "/home/user/.mail/.notmuch_config")))
+@end example
-@node Basic Usage
-@subsection Basic Usage
+Search engines like notmuch, namazu and mairix 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,
+returning a list of absolute file names for matching messages.
+
+These engines have a handful of configuration parameters that can
+either be set as a default option for all engines of that type, or set
+per-engine in your server config. These common paramters are:
+
+@itemize
+@item
+@code{program}: The name of the executable. Defaults to the plain
+program name such as ``notmuch'' or ``namazu''.
+
+@item
+@code{config-file}: The absolute filename of the configuration file
+for this search engine.
+
+@item
+@code{remove-prefix}: The directory part to be removed from the
+filenames returned by the search query. This absolute path should
+include everything up to the top level of the message store.
+
+@item
+@code{switches}: Additional command-line switches to be fed to the
+search program. The value of this parameter must be a list of
+strings, one string per switch.
+
+@end itemize
+
+The options above can be set in one of two ways: using a customization
+option that is set for all engines of that type, or on a per-engine
+basis in your server configuration files.
+
+The customization options are formed on the pattern
+@code{gnus-search-<engine>-<parameter>}. For instance, to use a
+non-standard notmuch program, you might set
+@code{gnus-search-notmuch-program} to ``/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++''.
+
+The options can also be set directly on your Gnus server definitions,
+for instance, in the @code{nnmaildir} example above. Note that the
+server options are part of the @code{gnus-search-engine} sexp, and the
+option symbol and value form a two-element list, not a cons cell.
+
+The namazu and swish-e engines each have an additional option,
+specifying where to store the index files. For namazu it is
+@code{index-directory}, and should be a single directory path. For
+swish-e it is @code{index-files}, and should be a list of strings.
+
+All indexed search engines come with their own method of updating
+their search indexes to include newly-arrived messages. Gnus
+currently provides no convenient interface for this, and you'll have
+to manage updates yourself, though this will likely change in the
+future.
+
+Lastly, all search engines accept a @code{raw-queries-p} option. This
+indicates that engines of this type (or this particular engine) should
+always use raw queries, never parsed (@xref{Search Queries}).
+
+@node Creating Search Groups
+@section Creating Search Groups
+@cindex creating search groups
In the group buffer typing @kbd{G G} will search the group on the
current line by calling @code{gnus-group-read-ephemeral-search-group}.
@@ -21525,297 +21625,137 @@ Basic Usage
original group for the article on the current line with @kbd{A W}, aka
@code{gnus-warp-to-article}.
-You say you want to search more than just the group on the current line?
-No problem: just process-mark the groups you want to search. You want
-even more? Calling for an nnir search with the cursor on a topic heading
-will search all the groups under that heading.
+You say you want to search more than just the group on the current
+line? No problem: just process-mark the groups you want to search.
+You want even more? Initiating a search with the cursor on a topic
+heading will search all the groups under that topic.
Still not enough? OK, in the server buffer
-@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G})
+@code{gnus-group-read-ephemeral-search-group} (here bound to @kbd{G})
will search all groups from the server on the current line. Too much?
Want to ignore certain groups when searching, like spam groups? Just
-customize @code{nnir-ignored-newsgroups}.
-
-One more thing: individual search engines may have special search
-features. You can access these special features by giving a
-prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you
-are searching multiple groups with different search engines you will
-be prompted for the special search features for each engine
-separately.
-
-
-@node Setting up nnir
-@subsection Setting up nnir
-
-To set up nnir you may need to do some prep work. Firstly, you may
-need to configure the search engines you plan to use. Some of them,
-like @code{imap}, need no special configuration. Others, like
-@code{namazu} and @code{swish}, require configuration as described
-below. Secondly, you need to associate a search engine with a server
-or a backend.
-
-If you just want to use the @code{imap} engine to search @code{nnimap}
-servers then you don't have to do anything. But you might want to
-read the details of the query language anyway.
-
-@menu
-* Associating Engines:: How to associate engines.
-* The imap Engine:: Imap configuration and usage.
-* The swish++ Engine:: Swish++ configuration and usage.
-* The swish-e Engine:: Swish-e configuration and usage.
-* The namazu Engine:: Namazu configuration and usage.
-* The notmuch Engine:: Notmuch configuration and usage.
-* The hyrex Engine:: Hyrex configuration and usage.
-* Customizations:: User customizable settings.
-@end menu
-
-@node Associating Engines
-@subsubsection Associating Engines
-
-
-When searching a group, @code{nnir} needs to know which search engine to
-use. You can configure a given server to use a particular engine by
-setting the server variable @code{nnir-search-engine} to the engine
-name. For example to use the @code{namazu} engine to search the server
-named @code{home} you can use
-
-@lisp
-(setq gnus-secondary-select-methods
- '((nnml "home"
- (nnimap-address "localhost")
- (nnir-search-engine namazu))))
-@end lisp
-
-Alternatively you might want to use a particular engine for all servers
-with a given backend. For example, you might want to use the @code{imap}
-engine for all servers using the @code{nnimap} backend. In this case you
-can customize the variable @code{nnir-method-default-engines}. This is
-an alist of pairs of the form @code{(backend . engine)}. By default this
-variable is set to use the @code{imap} engine for all servers using the
-@code{nnimap} backend. But if you wanted to use @code{namazu} for all
-your servers with an @code{nnimap} backend you could change this to
-
-@lisp
-'((nnimap . namazu))
-@end lisp
-
-@node The imap Engine
-@subsubsection The imap Engine
-
-The @code{imap} engine requires no configuration.
-
-Queries using the @code{imap} engine follow a simple query language.
-The search is always case-insensitive and supports the following
-features (inspired by the Google search input language):
-
-@table @samp
-
-@item Boolean query operators
-AND, OR, and NOT are supported, and parentheses can be used to control
-operator precedence, e.g., (emacs OR xemacs) AND linux. Note that
-operators must be written with all capital letters to be
-recognized. Also preceding a term with a @minus{} sign is equivalent
-to NOT term.
-
-@item Automatic AND queries
-If you specify multiple words then they will be treated as an AND
-expression intended to match all components.
-
-@item Phrase searches
-If you wrap your query in double-quotes then it will be treated as a
-literal string.
-
-@end table
-
-By default the whole message will be searched. The query can be limited
-to a specific part of a message by using a prefix-arg. After inputting
-the query this will prompt (with completion) for a message part.
-Choices include ``Whole message'', ``Subject'', ``From'', and
-``To''. Any unrecognized input is interpreted as a header name. For
-example, typing @kbd{Message-ID} in response to this prompt will limit
-the query to the Message-ID header.
-
-Finally selecting ``Imap'' will interpret the query as a raw
-@acronym{IMAP} search query. The format of such queries can be found in
-RFC3501.
-
-If you don't like the default of searching whole messages you can
-customize @code{nnir-imap-default-search-key}. For example to use
-@acronym{IMAP} queries by default
+customize @code{gnus-search-ignored-newsgroups}: groups matching this
+regexp will be ignored.
+
+@node Search Queries
+@section Search Queries
+@cindex search queries
+@cindex search syntax
+
+Gnus provides an optional unified search syntax that can be used
+across all supported search engines. This can be convenient in that
+you don't have to remember different search syntaxes; it's also
+possible to mark multiple groups indexed by different engines and
+issue a single search against them.
+
+@vindex gnus-search-use-parsed-queries
+Set the option @code{gnus-search-use-parsed-queries} to non-@code{nil}
+to enable this -- it is @code{nil} by default. Even if it is
+non-@code{nil}, it's still possible to turn off parsing for a class of
+engines or a single engine (@pxref{Search Engines}), or a single
+search by giving a prefix argument to any of the search commands.
+
+The search syntax is fairly simple: keys and values are separated by a
+colon, multi-word values must be quoted, ``and'' is implicit, ``or''
+is explicit, ``not'' will negate the following expression (or keys can
+be prefixed with a ``-''),and parentheses can be used to group logical
+sub-clauses. For example:
-@lisp
-(setq nnir-imap-default-search-key "Imap")
-@end lisp
-
-@node The swish++ Engine
-@subsubsection The swish++ Engine
-
-FIXME: Say something more here.
-
-Documentation for swish++ may be found at the swish++ sourceforge page:
-@uref{http://swishplusplus.sourceforge.net}
-
-@table @code
-
-@item nnir-swish++-program
-The name of the swish++ executable. Defaults to @code{search}
-
-@item nnir-swish++-additional-switches
-A list of strings to be given as additional arguments to
-swish++. @code{nil} by default.
-
-@item nnir-swish++-remove-prefix
-The prefix to remove from each file name returned by swish++ in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The swish-e Engine
-@subsubsection The swish-e Engine
-
-FIXME: Say something more here.
-
-@table @code
-
-@item nnir-swish-e-program
-The name of the swish-e search program. Defaults to @code{swish-e}.
-
-@item nnir-swish-e-additional-switches
-A list of strings to be given as additional arguments to
-swish-e. @code{nil} by default.
-
-@item nnir-swish-e-remove-prefix
-The prefix to remove from each file name returned by swish-e in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The namazu Engine
-@subsubsection The namazu Engine
-
-Using the namazu engine requires creating and maintaining index files.
-One directory should contain all the index files, and nnir must be told
-where to find them by setting the @code{nnir-namazu-index-directory}
-variable.
-
-To work correctly the @code{nnir-namazu-remove-prefix} variable must
-also be correct. This is the prefix to remove from each file name
-returned by Namazu in order to get a proper group name (albeit with @samp{/}
-instead of @samp{.}).
-
-For example, suppose that Namazu returns file names such as
-@samp{/home/john/Mail/mail/misc/42}. For this example, use the
-following setting: @code{(setq nnir-namazu-remove-prefix
-"/home/john/Mail/")} Note the trailing slash. Removing this prefix from
-the directory gives @samp{mail/misc/42}. @code{nnir} knows to remove
-the @samp{/42} and to replace @samp{/} with @samp{.} to arrive at the
-correct group name @samp{mail.misc}.
-
-Extra switches may be passed to the namazu search command by setting the
-variable @code{nnir-namazu-additional-switches}. It is particularly
-important not to pass any switches to namazu that will change the
-output format. Good switches to use include @option{--sort},
-@option{--ascending}, @option{--early} and @option{--late}.
-Refer to the Namazu documentation for further
-information on valid switches.
-
-Mail must first be indexed with the @command{mknmz} program. Read the
-documentation for namazu to create a configuration file. Here is an
-example:
-
-@cartouche
@example
- package conf; # Don't remove this line!
-
- # Paths which will not be indexed. Don't use '^' or '$' anchors.
- $EXCLUDE_PATH = "spam|sent";
-
- # Header fields which should be searchable. case-insensitive
- $REMAIN_HEADER = "from|date|message-id|subject";
-
- # Searchable fields. case-insensitive
- $SEARCH_FIELD = "from|date|message-id|subject";
-
- # The max length of a word.
- $WORD_LENG_MAX = 128;
-
- # The max length of a field.
- $MAX_FIELD_LENGTH = 256;
+(from:john or from:peter) subject: ``lunch tomorrow'' since:3d
@end example
-@end cartouche
-For this example, mail is stored in the directories @samp{~/Mail/mail/},
-@samp{~/Mail/lists/} and @samp{~/Mail/archive/}, so to index them go to
-the index directory set in @code{nnir-namazu-index-directory} and issue
-the following command:
+The syntax is made to be accepted by a wide range of engines, and thus
+will happily accept most input, valid or not. Some terms will only be
+meaningful to some engines; other engines will drop them silently.
-@example
-mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
-@end example
-
-For maximum searching efficiency you might want to have a cron job run
-this command periodically, say every four hours.
+Key completion is offered on @key{TAB}, but it's also possible to
+enter the query with abbreviated keys, which will be expanded during
+parsing. If a key is abbreviated to the point of ambiguity (for
+instance, ``s:'' could be ``subject:'' or ``since:''), an error will
+be raised.
+Supported keys include all the usual mail headers: ``from'', ``subject'', ``cc'', etc. Other keys are:
-@node The notmuch Engine
-@subsubsection The notmuch Engine
-
-@table @code
-@item nnir-notmuch-program
-The name of the notmuch search executable. Defaults to
-@samp{notmuch}.
-
-@item nnir-notmuch-additional-switches
-A list of strings, to be given as additional arguments to notmuch.
-
-@item nnir-notmuch-remove-prefix
-The prefix to remove from each file name returned by notmuch in order
-to get a group name (albeit with @samp{/} instead of @samp{.}). This
-is a regular expression.
-
-@item nnir-notmuch-filter-group-names-function
-A function used to transform the names of groups being searched in,
-for use as a ``path:'' search keyword for notmuch. If nil, the
-default, ``path:'' keywords are not used. Otherwise, this should be a
-callable which accepts a single group name and returns a transformed
-name as notmuch expects to see it. In many mail backends, for
-instance, dots in group names must be converted to forward slashes: to
-achieve this, set this option to
-@example
-(lambda (g) (replace-regexp-in-string "\\." "/" g))
-@end example
+@itemize
+@item
+body:
+@item
+recipient: to or cc or bcc
+@item
+address: from or recipient
+@item
+mark: Accepts ``flag'', ``seen'', ``read'' or ``replied'', or any of
+Gnus' single-letter representations of those marks, i.e. ``mark:R''
+for ``read''.
+@item
+tag: This is interpreted as ``keyword'' for IMAP and ``tag'' for
+notmuch.
+@item
+attachment: Matches the attachment file name.
+@item
+before: Date is exclusive; see below for date parsing.
+@item
+after: Date is inclusive; can also use ``since''.
+@item
+thread: Return entire message threads, not just individual messages.
+@item
+raw: Do not parse this particular search.
+@item
+limit: Limit the results to this many messages. When searching
+multiple groups this may give undesired results, as the limiting
+happens before sorting.
+@item
+grep: On systems with a grep command, additionally filter the results
+by using the value of this term as a grep regexp.
+@end itemize
-@end table
+@vindex gnus-search-contact-sources
+If an elisp-based contact management packages (e.g. BBDB or EBDB)
+pushes a function onto the option @code{gnus-search-contact-sources},
+three other keys become available:
+@itemize
+@item
+contact-from: Search by contact name, and the actual search will use
+all the contact's email addresses.
+@item
+contact-to: The same, but as if ``recipient''.
+@item
+contact: The same, but as if ``address''.
+@end itemize
-@node The hyrex Engine
-@subsubsection The hyrex Engine
-This engine is obsolete.
+@subsection Date value parsing
-@node Customizations
-@subsubsection Customizations
+@vindex gnus-search-date-keys
+Date-type keys (see @code{gnus-search-date-keys}) will accept a wide
+variety of values. First, anything that @code{parse-time-string} can
+parse is acceptable. Dates with missing values will be interpreted as
+the most recent occurance thereof: for instance ``march 03'' is the
+most recent March 3rd. Lastly, it's possible to use relative
+specifications, such as ``3d'' (three days ago). This format also accepts
+w, m and y.
-@table @code
+When creating persistent search groups, the search is saved unparsed,
+and re-parsed every time the group is updated. So a permanent search
+group with a query like:
-@item nnir-method-default-engines
-Alist of pairs of server backends and search engines. The default
-association is
@example
-(nnimap . imap)
+from: ``my boss'' mark:flag since:1w
@end example
-@item nnir-ignored-newsgroups
-A regexp to match newsgroups in the active file that should be skipped
-when searching all groups on a server.
-
-@end table
-
+would always contain only messages from the past seven days.
@node nnmairix
@section nnmairix
@cindex mairix
@cindex nnmairix
+
+This section is now mostly obsolete, as mairix can be used as a regular
+search engine, including persistent search groups, with
+@code{nnselect}.
+
This paragraph describes how to set up mairix and the back end
@code{nnmairix} for indexing and searching your mail from within
Gnus. Additionally, you can create permanent ``smart'' groups which are
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 1d614f8a8d..c6f7e1c41a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -3165,29 +3165,27 @@ gnus-group-make-directory-group
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-
-(autoload 'nnir-read-parms "nnir")
-(autoload 'nnir-server-to-search-engine "nnir")
(autoload 'gnus-group-topic-name "gnus-topic")
+(autoload 'gnus-search-make-spec "gnus-search")
;; Temporary to make group creation easier
-(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-make-search-group (no-parse &optional specs)
"Make a group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let ((name (gnus-read-group "Group name: ")))
(with-current-buffer gnus-group-buffer
(let* ((group-spec
(or
- (cdr (assq 'nnir-group-spec specs))
+ (cdr (assq 'search-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3199,16 +3197,8 @@ gnus-group-make-search-group
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
(query-spec
(or
- (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (cdr (assq 'search-query-spec specs))
+ (gnus-search-make-spec no-parse))))
(gnus-group-make-group
name
(list 'nnselect "nnselect")
@@ -3216,29 +3206,29 @@ gnus-group-make-search-group
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))))
(define-obsolete-function-alias 'gnus-group-make-nnir-group
'gnus-group-read-ephemeral-search-group "28.1")
-(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-read-ephemeral-search-group (no-parse &optional specs)
"Read an nnselect group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
+ (or (cdr (assq 'search-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3249,16 +3239,8 @@ gnus-group-read-ephemeral-search-group
(cdr
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
(query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (or (cdr (assq 'search-query-spec specs))
+ (gnus-search-make-spec no-parse))))
(gnus-group-read-ephemeral-group
(concat "nnselect-" (message-unique-id))
(list 'nnselect "nnselect")
@@ -3268,10 +3250,10 @@ gnus-group-read-ephemeral-search-group
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))
(defun gnus-group-add-to-virtual (n vgroup)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
new file mode 100644
index 0000000000..50007da4d3
--- /dev/null
+++ b/lisp/gnus/gnus-search.el
@@ -0,0 +1,2230 @@
+;;; gnus-search.el --- Search facilities for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines a generalized search language, and search engines
+;; that interface with various search programs. It is responsible for
+;; parsing the user's search input, sending that query to the search
+;; engines, and collecting results. Results are in the form of a
+;; vector of vectors, each vector representing a found article. The
+;; nnselect backend interprets that value to create a group containing
+;; the search results.
+
+;; This file was formerly known as nnir. Later, the backend parts of
+;; nnir became nnselect, and only the search functionality was left
+;; here.
+
+;; See the Gnus manual for details of the search language. Tests are
+;; in tests/gnus-search-test.el.
+
+;; The search parsing routines are responsible for accepting the
+;; user's search query as a string and parsing it into a sexp
+;; structure. The function `gnus-search-parse-query' is the entry
+;; point for that. Once the query is in sexp form, it is passed to
+;; the search engines themselves, which are responsible for
+;; transforming the query into a form that the external program can
+;; understand, and then filtering the search results into a format
+;; that nnselect can understand.
+
+;; The general flow is:
+
+;; 1. The user calls one of `gnus-group-make-search-group' or
+;; `gnus-group-make-permanent-search-group' (or a few other entry
+;; points). These functions prompt for a search query, and collect
+;; the groups to search, then create an nnselect group, setting an
+;; 'nnselect-specs group parameter where 'nnselect-function is
+;; `gnus-search-run-query', and 'nnselect-args is the search query and
+;; groups to search.
+
+;; 2. `gnus-search-run-query' is called with 'nnselect-args. It looks
+;; at the groups to search, categorizes them by server, and for each
+;; server finds the search engine to use. It calls each engine's
+;; `gnus-search-run-search' method with the query and groups passed as
+;; arguments, and the results are collected and handed off to the
+;; nnselect group.
+
+;; For information on writing new search engines, see the Gnus manual.
+
+;;; Code:
+
+(require 'gnus-group)
+(require 'gnus-sum)
+(require 'message)
+(require 'gnus-util)
+(require 'eieio)
+(eval-when-compile (require 'cl-lib))
+(autoload 'eieio-build-class-alist "eieio-opt")
+(autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-english-month-names)
+
+;;; Internal Variables:
+
+(defvar gnus-search-memo-query nil
+ "Internal: stores current query.")
+
+(defvar gnus-search-memo-server nil
+ "Internal: stores current server.")
+
+(defvar gnus-search-history ()
+ "Internal history of Gnus searches.")
+
+(define-error 'gnus-search-parse-error "Gnus search parsing error")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-search nil
+ "Search groups in Gnus with assorted search engines."
+ :group 'gnus)
+
+(defcustom gnus-search-use-parsed-queries nil
+ "When t, use Gnus' generalized search language.
+The generalized search language is a search language that can be
+used across all search engines that Gnus supports. See the Gnus
+manual for details.
+
+If this option is set to nil, search queries will be passed
+directly to the search engines without being parsed or
+transformed."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(define-obsolete-variable-alias 'nnir-ignored-newsgroups
+ 'gnus-search-ignored-newsgroups "28.1")
+
+(defcustom gnus-search-ignored-newsgroups ""
+ "A regexp to match newsgroups in the active file that should
+ be skipped when searching."
+ :version "24.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+;; Engine-specific configuration options.
+
+(defcustom gnus-search-swish++-config-file
+ (expand-file-name "~/Mail/swish++.conf")
+ "Location of Swish++ configuration file.
+This variable can also be set per-server."
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-program "search"
+ "Name of swish++ search executable.
+This variable can also be set per-server."
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-switches '()
+ "A list of strings, to be given as additional arguments to swish++.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish++-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish++-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish++
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-raw-queries-p nil
+ "If t, all Swish++ engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-config-file
+ (expand-file-name "~/Mail/swish-e.conf")
+ "Configuration file for swish-e.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-program "search"
+ "Name of swish-e search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-switches '()
+ "A list of strings, to be given as additional arguments to swish-e.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish-e-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish-e-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish-e
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-index-files '()
+ "A list of index files to use with this Swish-e instance.
+This variable can also be set per-server."
+ :type '(repeat file)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-raw-queries-p nil
+ "If t, all Swish-e engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+;; Namazu engine, see <URL:http://www.namazu.org/>
+
+(defcustom gnus-search-namazu-program "namazu"
+ "Name of Namazu search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-index-directory (expand-file-name "~/Mail/namazu/")
+ "Index directory for Namazu.
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-switches '()
+ "A list of strings, to be given as additional arguments to namazu.
+The switches `-q', `-a', and `-s' are always used, very few other switches
+make any sense in this context.
+
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-namazu-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-namazu-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by Namazu
+in order to get a group name (albeit with / instead of .).
+
+For example, suppose that Namazu returns file names such as
+\"/home/john/Mail/mail/misc/42\". For this example, use the following
+setting: (setq gnus-search-namazu-remove-prefix \"/home/john/Mail/\")
+Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
+Gnus knows to remove the \"/42\" and to replace \"/\" with \".\" to
+arrive at the correct group name, \"mail.misc\".
+
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-raw-queries-p nil
+ "If t, all Namazu engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-program "notmuch"
+ "Name of notmuch search executable.
+This variable can also be set per-server."
+ :type '(string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-config-file
+ (expand-file-name "~/.notmuch-config")
+ "Configuration file for notmuch.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-switches '()
+ "A list of strings, to be given as additional arguments to notmuch.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-notmuch-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-notmuch-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by notmuch
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-raw-queries-p nil
+ "If t, all Notmuch engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-imap-raw-queries-p nil
+ "If t, all IMAP engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-program "mairix"
+ "Name of mairix search executable.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-config-file
+ (expand-file-name "~/.mairixrc")
+ "Configuration file for mairix.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-switches '()
+ "A list of strings, to be given as additional arguments to mairix.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mairix-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnu-search-mairix-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by mairix
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-raw-queries-p nil
+ "If t, all Mairix engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+;; Options for search language parsing.
+
+(defcustom gnus-search-expandable-keys
+ '("from" "subject" "to" "cc" "bcc" "body" "recipient" "date"
+ "mark" "contact" "contact-from" "contact-to" "before" "after"
+ "larger" "smaller" "attachment" "text" "since" "thread"
+ "sender" "address" "tag" "size" "grep" "limit" "raw")
+ "A list of strings representing expandable search keys.
+\"Expandable\" simply means the key can be abbreviated while
+typing in search queries, ie \"subject\" could be entered as
+\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subject\" and \"since\".
+
+Keys can contain hyphens, in which case each section will be
+expanded separately. \"cont\" will expand to \"contact\", for
+instance, while \"c-t\" will expand to \"contact-to\".
+
+Ambiguous abbreviations will raise an error."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-date-keys
+ '("date" "before" "after" "on" "senton" "sentbefore" "sentsince" "since")
+ "A list of keywords whose value should be parsed as a date.
+See the docstring of `gnus-search-parse-query' for information on
+date parsing."
+ :group 'gnus-search
+ :version "26.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-contact-sources nil
+ "A list of sources used to search for messages from contacts.
+Each list element can be either a function, or an alist.
+Functions should accept a search string, and return a list of
+email addresses of matching contacts. An alist should map single
+strings to lists of mail addresses, usable as search keys in mail
+headers."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat (choice function
+ (alist
+ :key-type string
+ :value-type (repeat string)))))
+
+;;; Search language
+
+;; This "language" was generalized from the original IMAP search query
+;; parsing routine.
+
+(defun gnus-search-parse-query (string)
+ "Turn STRING into an s-expression based query.
+The resulting query structure is passed to the various search
+backends, each of which adapts it as needed.
+
+The search \"language\" is essentially a series of key:value
+expressions. Key is most often a mail header, but there are
+other keys. Value is a string, quoted if it contains spaces.
+Key and value are separated by a colon, no space. Expressions
+are implictly ANDed; the \"or\" keyword can be used to
+OR. \"not\" will negate the following expression, or keys can be
+prefixed with a \"-\". The \"near\" operator will work for
+engines that understand it; other engines will convert it to
+\"or\". Parenthetical groups work as expected.
+
+A key that matches the name of a mail header will search that
+header.
+
+Search keys can be abbreviated so long as they remain
+unambiguous, ie \"f\" will search the \"from\" header. \"s\" will
+raise an error.
+
+Other keys:
+
+\"address\" will search all sender and recipient headers.
+
+\"recipient\" will search \"To\", \"Cc\", and \"Bcc\".
+
+\"before\" will search messages sent before the specified
+date (date specifications to come later). Date is exclusive.
+
+\"after\" (or its synonym \"since\") will search messages sent
+after the specified date. Date is inclusive.
+
+\"mark\" will search messages that have some sort of mark.
+Likely values include \"flag\", \"seen\", \"read\", \"replied\".
+It's also possible to use Gnus' internal marks, ie \"mark:R\"
+will be interpreted as mark:read.
+
+\"tag\" will search tags -- right now that's translated to
+\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some
+point this should also be used to search marks in the Gnus
+registry.
+
+\"contact\" will search messages to/from a contact. Contact
+management packages must push a function onto
+`gnus-search-contact-sources', the docstring of which see, for
+this to work.
+
+\"contact-from\" does what you'd expect.
+
+\"contact-to\" searches the same headers as \"recipient\".
+
+Other keys can be specified, provided that the search backends
+know how to interpret them.
+
+Date values (any key in `gnus-search-date-keys') can be provided
+in any format that `parse-time-string' can parse (note that this
+can produce weird results). Dates with missing bits will be
+interpreted as the most recent occurance thereof (ie \"march 03\"
+is the most recent March 3rd). Lastly, relative specifications
+such as 1d (one day ago) are understood. This also accepts w, m,
+and y. m is assumed to be 30 days.
+
+This function will accept pretty much anything as input. Its
+only job is to parse the query into a sexp, and pass that on --
+it is the job of the search backends to make sense of the
+structured query. Malformed, unusable or invalid queries will
+typically be silently ignored."
+ (with-temp-buffer
+ ;; Set up the parsing environment.
+ (insert string)
+ (goto-char (point-min))
+ ;; Now, collect the output terms and return them.
+ (let (out)
+ (while (not (gnus-search-query-end-of-input))
+ (push (gnus-search-query-next-expr) out))
+ (reverse out))))
+
+(defun gnus-search-query-next-expr (&optional count halt)
+ "Return the next expression from the current buffer."
+ (let ((term (gnus-search-query-next-term count))
+ (next (gnus-search-query-peek-symbol)))
+ ;; Deal with top-level expressions. And, or, not, near... What
+ ;; else? Notmuch also provides xor and adj. It also provides a
+ ;; "nearness" parameter for near and adj.
+ (cond
+ ;; Handle 'expr or expr'
+ ((and (eq next 'or)
+ (null halt))
+ (list 'or term (gnus-search-query-next-expr 2)))
+ ;; Handle 'near operator.
+ ((eq next 'near)
+ (let ((near-next (gnus-search-query-next-expr 2)))
+ (if (and (stringp term)
+ (stringp near-next))
+ (list 'near term near-next)
+ (signal 'gnus-search-parse-error
+ (list "\"Near\" keyword must appear between two plain strings.")))))
+ ;; Anything else
+ (t term))))
+
+(defun gnus-search-query-next-term (&optional count)
+ "Return the next TERM from the current buffer."
+ (let ((term (gnus-search-query-next-symbol count)))
+ ;; What sort of term is this?
+ (cond
+ ;; negated term
+ ((eq term 'not) (list 'not (gnus-search-query-next-expr nil 'halt)))
+ ;; generic term
+ (t term))))
+
+(defun gnus-search-query-peek-symbol ()
+ "Return the next symbol from the current buffer, but don't consume it."
+ (save-excursion
+ (gnus-search-query-next-symbol)))
+
+(defun gnus-search-query-next-symbol (&optional count)
+ "Return the next symbol from the current buffer, or nil if we are
+at the end of the buffer. If supplied COUNT skips some symbols before
+returning the one at the supplied position."
+ (when (and (numberp count) (> count 1))
+ (gnus-search-query-next-symbol (1- count)))
+ (let ((case-fold-search t))
+ ;; end of input stream?
+ (unless (gnus-search-query-end-of-input)
+ ;; No, return the next symbol from the stream.
+ (cond
+ ;; Negated expression -- return it and advance one char.
+ ((looking-at "-") (forward-char 1) 'not)
+ ;; List expression -- we parse the content and return this as a list.
+ ((looking-at "(")
+ (gnus-search-parse-query (gnus-search-query-return-string ")" t)))
+ ;; Keyword input -- return a symbol version.
+ ((looking-at "\\band\\b") (forward-char 3) 'and)
+ ((looking-at "\\bor\\b") (forward-char 2) 'or)
+ ((looking-at "\\bnot\\b") (forward-char 3) 'not)
+ ((looking-at "\\bnear\\b") (forward-char 4) 'near)
+ ;; Plain string, no keyword
+ ((looking-at "[\"/]?\\b[^:]+\\([[:blank:]]\\|\\'\\)")
+ (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t)))
+ ;; Assume a K:V expression.
+ (t (let ((key (gnus-search-query-expand-key
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward ":" (point-at-eol) t)
+ (1- (point))))))
+ (value (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t))))
+ (gnus-search-query-parse-kv key value)))))))
+
+(defun gnus-search-query-parse-kv (key value)
+ "Handle KEY and VALUE, parsing and expanding as necessary.
+This may result in (key value) being turned into a larger query
+structure.
+
+In the simplest case, they are simply consed together. String
+KEY is converted to a symbol."
+ (let (return)
+ (cond
+ ((member key gnus-search-date-keys)
+ (when (string= "after" key)
+ (setq key "since"))
+ (setq value (gnus-search-query-parse-date value)))
+ ((string-match-p "contact" key)
+ (setq return (gnus-search-query-parse-contact key value)))
+ ((equal key "mark")
+ (setq value (gnus-search-query-parse-mark value))))
+ (or return
+ (cons (intern key) value))))
+
+(defun gnus-search-query-parse-date (value &optional rel-date)
+ "Interpret VALUE as a date specification.
+See the docstring of `gnus-search-parse-query' for details.
+
+The result is a list of (dd mm yyyy); individual elements can be
+nil.
+
+If VALUE is a relative time, interpret it as relative to
+REL-DATE, or (current-time) if REL-DATE is nil."
+ ;; Time parsing doesn't seem to work with slashes.
+ (let ((value (replace-regexp-in-string "/" "-" value))
+ (now (append '(0 0 0)
+ (seq-subseq (decode-time (or rel-date
+ (current-time)))
+ 3))))
+ ;; Check for relative time parsing.
+ (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
+ (seq-subseq
+ (decode-time
+ (time-subtract
+ (apply #'encode-time now)
+ (days-to-time
+ (* (string-to-number (match-string 1 value))
+ (cdr (assoc (match-string 2 value)
+ '(("d" . 1)
+ ("w" . 7)
+ ("m" . 30)
+ ("y" . 365))))))))
+ 3 6)
+ ;; Otherwise check the value of `parse-time-string'.
+
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+ (let ((d-time (parse-time-string value)))
+ ;; Did parsing produce anything at all?
+ (if (seq-some #'integerp (seq-subseq d-time 3 7))
+ (seq-subseq
+ ;; If DOW is given, handle that specially.
+ (if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
+ (decode-time
+ (time-subtract (apply #'encode-time now)
+ (days-to-time
+ (+ (if (> (seq-elt d-time 6)
+ (seq-elt now 6))
+ 7 0)
+ (- (seq-elt now 6) (seq-elt d-time 6))))))
+ d-time)
+ 3 6)
+ ;; `parse-time-string' failed to produce anything, just
+ ;; return the string.
+ value)))))
+
+(defun gnus-search-query-parse-mark (mark)
+ "Possibly transform MARK.
+If MARK is a single character, assume it is one of the
+gnus-*-mark marks, and return an appropriate string."
+ (if (= 1 (length mark))
+ (let ((m (aref mark 0)))
+ ;; Neither pcase nor cl-case will work here.
+ (cond
+ ((eql m gnus-ticked-mark) "flag")
+ ((eql m gnus-read-mark) "read")
+ ((eql m gnus-replied-mark) "replied")
+ ((eql m gnus-recent-mark) "recent")
+ (t mark)))
+ mark))
+
+(defun gnus-search-query-parse-contact (key value)
+ "Handle VALUE as the name of a contact.
+Runs VALUE through the elements of
+`gnus-search-contact-sources' until one of them returns a list
+of email addresses. Turns those addresses into an appropriate
+chunk of query syntax."
+ (let ((funcs (or (copy-sequence gnus-search-contact-sources)
+ (signal 'gnus-search-parse-error
+ (list "No functions for handling contacts."))))
+ func addresses)
+ (while (and (setq func (pop funcs))
+ (null addresses))
+ (setq addresses (if (functionp func)
+ (funcall func value)
+ (when (string= value (car func))
+ (cdr func)))))
+ (unless addresses
+ (setq addresses (list value)))
+ ;; Simplest case: single From address.
+ (if (and (null (cdr addresses))
+ (equal key "contact-from"))
+ (cons 'sender (car addresses))
+ (cons
+ 'or
+ (mapcan
+ (lambda (a)
+ (pcase key
+ ("contact-from"
+ (list (cons 'sender a)))
+ ("contact-to"
+ (list (cons 'recipient a)))
+ ("contact"
+ (list (cons 'address a)))))
+ addresses)))))
+
+(defun gnus-search-query-expand-key (key)
+ (cond ((test-completion key gnus-search-expandable-keys)
+ ;; We're done!
+ key)
+ ;; There is more than one possible completion.
+ ((consp (cdr (completion-all-completions
+ key gnus-search-expandable-keys #'stringp 0)))
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key))))
+ ;; Return KEY, either completed or untouched.
+ ((car-safe (completion-try-completion
+ key gnus-search-expandable-keys
+ #'stringp 0)))))
+
+(defun gnus-search-query-return-string (&optional delimited trim)
+ "Return a string from the current buffer.
+If DELIMITED is non-nil, assume the next character is a delimiter
+character, and return everything between point and the next
+occurance of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
+return one word."
+ ;; This function cannot handle nested delimiters, as it's not a
+ ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
+ ;; (cc:bob or bcc:bob))".
+ (let ((start (point))
+ (delimiter (if (stringp delimited)
+ delimited
+ (when delimited
+ (char-to-string (char-after)))))
+ end)
+ (if delimiter
+ (progn
+ (when trim
+ ;; Skip past first delimiter if we're trimming.
+ (forward-char 1))
+ (while (not end)
+ (unless (search-forward delimiter nil t (unless trim 2))
+ (signal 'gnus-search-parse-error
+ (list (format "Unmatched delimited input with %s in query" delimiter))))
+ (let ((here (point)))
+ (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+ (setq end (if trim (1- (point)) (point))
+ start (if trim (1+ start) start))))))
+ (setq end (progn (re-search-forward "\\([[:blank:]]+\\|$\\)" (point-max) t)
+ (match-beginning 0))))
+ (buffer-substring-no-properties start end)))
+
+(defun gnus-search-query-end-of-input ()
+ "Are we at the end of input?"
+ (skip-chars-forward "[[:blank:]]")
+ (looking-at "$"))
+
+;;; Search engines
+
+;; Search engines are implemented as classes. This is good for two
+;; things: encapsulating things like indexes and search prefixes, and
+;; transforming search queries.
+
+(defclass gnus-search-engine ()
+ ((raw-queries-p
+ :initarg :raw-queries-p
+ :initform nil
+ :type boolean
+ :custom boolean
+ :documentation
+ "When t, searches through this engine will never be parsed or
+ transformed, and must be entered \"raw\"."))
+ :abstract t
+ :documentation "Abstract base class for Gnus search engines.")
+
+(defclass gnus-search-grep ()
+ ((grep-program
+ :initarg :grep-program
+ :initform "grep"
+ :type string
+ :documentation "Grep executable to use for second-pass grep
+ searches.")
+ (grep-options
+ :initarg :grep-options
+ :initform nil
+ :type list
+ :documentation "Additional options, in the form of a list,
+ passed to the second-pass grep search, when present."))
+ :abstract t
+ :documentation "An abstract mixin class that can be added to
+ local-filesystem search engines, providing an additional grep:
+ search key. After the base engine returns a list of search
+ results (as local filenames), an external grep process is used
+ to further filter the results.")
+
+(cl-defgeneric gnus-search-grep-search (engine artlist criteria)
+ "Run a secondary grep search over a list of preliminary results.
+
+ARTLIST is a list of (filename score) pairs, produced by one of
+the other search engines. CRITERIA is a grep-specific search
+key. This method uses an external grep program to further filter
+the files in ARTLIST by that search key.")
+
+(cl-defmethod gnus-search-grep-search ((engine gnus-search-grep)
+ artlist criteria)
+ (with-slots (grep-program grep-options) engine
+ (if (executable-find grep-program)
+ ;; Don't catch errors -- allow them to propagate.
+ (let ((matched-files
+ (apply
+ #'process-lines
+ grep-program
+ `("-l" ,@grep-options
+ "-e" ,(shell-quote-argument criteria)
+ ,@(mapcar #'car artlist)))))
+ (seq-filter (lambda (a) (member (car a) matched-files))
+ artlist))
+ (nnheader-report 'search "invalid grep program: %s" grep-program))))
+
+(defclass gnus-search-process ()
+ ((proc-buffer
+ :initarg :proc-buffer
+ :type buffer
+ :documentation "A temporary buffer this engine uses for its
+ search process, and for munging its search results."))
+ :abstract t
+ :documentation
+ "A mixin class for engines that do their searching in a single
+ process launched for this purpose, which returns at the end of
+ the search. Subclass instances are safe to be run in
+ threads.")
+
+(cl-defmethod shared-initialize ((engine gnus-search-process)
+ slots)
+ (setq slots (plist-put slots :proc-buffer
+ (get-buffer-create
+ (generate-new-buffer-name " *gnus-search-"))))
+ (cl-call-next-method engine slots))
+
+(defclass gnus-search-imap (gnus-search-engine)
+ ((literal-plus
+ :initarg :literal-plus
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle literal+ searches? This slot
+ is set automatically by the imap server, and cannot be
+ set manually. Only the LITERAL+ capability is handled.")
+ (multisearch
+ :initarg :multisearch
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the MULTISEARCH capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently unimplemented.")
+ (fuzzy
+ :initarg :fuzzy
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the FUZZY search capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently only partially implemented."))
+ :documentation
+ "The base IMAP search engine, using an IMAP server's search capabilites.
+
+This backend may be subclassed to handle particular IMAP servers'
+quirks.")
+
+(eieio-oset-default 'gnus-search-imap 'raw-queries-p
+ gnus-search-imap-raw-queries-p)
+
+(defclass gnus-search-find-grep (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ nil)
+
+(defclass gnus-search-gmane (gnus-search-engine gnus-search-process)
+ nil)
+
+;;; The "indexed" search engine. These are engines that use an
+;;; external program, with indexes kept on disk, to search messages
+;;; usually kept in some local directory. The three common slots are
+;;; "program", holding the string name of the executable; "switches",
+;;; holding additional switches to pass to the executable; and
+;;; "prefix", which is sort of the path to the found messages which
+;;; should be removed so that Gnus can find them. Many of the
+;;; subclasses also allow distinguishing multiple databases or
+;;; indexes. These slots can be set using a global default, or on a
+;;; per-server basis.
+
+(defclass gnus-search-indexed (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ ((program
+ :initarg :program
+ :type string
+ :documentation
+ "The executable used for indexing and searching.")
+ (config-file
+ :init-arg :config-file
+ :type string
+ :custom file
+ :documentation "Location of the config file, if any.")
+ (remove-prefix
+ :initarg :remove-prefix
+ :type string
+ :documentation
+ "The path to the directory where the indexed mails are
+ kept. This path is removed from the search results.")
+ (switches
+ :initarg :switches
+ :type list
+ :documentation
+ "Additional switches passed to the search engine command-line
+ program."))
+ :abstract t
+ :allow-nil-initform t
+ :documentation "A base search engine class that assumes a local search index
+ accessed by a command line program.")
+
+(eieio-oset-default 'gnus-search-indexed 'remove-prefix
+ (concat (getenv "HOME") "/Mail/"))
+
+(defclass gnus-search-swish-e (gnus-search-indexed)
+ ((index-files
+ :init-arg :index-files
+ :type list)))
+
+(eieio-oset-default 'gnus-search-swish-e 'program
+ gnus-search-swish-e-program)
+
+(eieio-oset-default 'gnus-search-swish-e 'remove-prefix
+ gnus-search-swish-e-remove-prefix)
+
+(eieio-oset-default 'gnus-search-swish-e 'index-files
+ gnus-search-swish-e-index-files)
+
+(eieio-oset-default 'gnus-search-swish-e 'switches
+ gnus-search-swish-e-switches)
+
+(eieio-oset-default 'gnus-search-swish-e 'raw-queries-p
+ gnus-search-swish-e-raw-queries-p)
+
+(defclass gnus-search-swish++ (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-swish++ 'program
+ gnus-search-swish++-program)
+
+(eieio-oset-default 'gnus-search-swish++ 'remove-prefix
+ gnus-search-swish++-remove-prefix)
+
+(eieio-oset-default 'gnus-search-swish++ 'config-file
+ gnus-search-swish++-config-file)
+
+(eieio-oset-default 'gnus-search-swish++ 'switches
+ gnus-search-swish++-switches)
+
+(eieio-oset-default 'gnus-search-swish++ 'raw-queries-p
+ gnus-search-swish++-raw-queries-p)
+
+(defclass gnus-search-mairix (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-mairix 'program
+ gnus-search-mairix-program)
+
+(eieio-oset-default 'gnus-search-mairix 'switches
+ gnus-search-mairix-switches)
+
+(eieio-oset-default 'gnus-search-mairix 'remove-prefix
+ gnus-search-mairix-remove-prefix)
+
+(eieio-oset-default 'gnus-search-mairix 'config-file
+ gnus-search-mairix-config-file)
+
+(eieio-oset-default 'gnus-search-mairix 'raw-queries-p
+ gnus-search-mairix-raw-queries-p)
+
+(defclass gnus-search-namazu (gnus-search-indexed)
+ ((index-directory
+ :initarg :index-directory
+ :type string
+ :custom directory)))
+
+(eieio-oset-default 'gnus-search-namazu 'program
+ gnus-search-namazu-program)
+
+(eieio-oset-default 'gnus-search-namazu 'index-directory
+ gnus-search-namazu-index-directory)
+
+(eieio-oset-default 'gnus-search-namazu 'switches
+ gnus-search-namazu-switches)
+
+(eieio-oset-default 'gnus-search-namazu 'remove-prefix
+ gnus-search-namazu-remove-prefix)
+
+(eieio-oset-default 'gnus-search-namazu 'raw-queries-p
+ gnus-search-namazu-raw-queries-p)
+
+(defclass gnus-search-notmuch (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-notmuch 'program
+ gnus-search-notmuch-program)
+
+(eieio-oset-default 'gnus-search-notmuch 'switches
+ gnus-search-notmuch-switches)
+
+(eieio-oset-default 'gnus-search-notmuch 'remove-prefix
+ gnus-search-notmuch-remove-prefix)
+
+(eieio-oset-default 'gnus-search-notmuch 'config-file
+ gnus-search-notmuch-config-file)
+
+(eieio-oset-default 'gnus-search-notmuch 'raw-queries-p
+ gnus-search-notmuch-raw-queries-p)
+
+(define-obsolete-variable-alias 'nnir-method-default-engines
+ 'gnus-search-default-engines "28.1")
+
+(defcustom gnus-search-default-engines '((nnimap gnus-search-imap)
+ (nntp gnus-search-gmane))
+ "Alist of default search engines keyed by server method."
+ :version "26.1"
+ :group 'gnus-search
+ :type `(repeat (list (choice (const nnimap) (const nntp) (const nnspool)
+ (const nneething) (const nndir) (const nnmbox)
+ (const nnml) (const nnmh) (const nndraft)
+ (const nnfolder) (const nnmaildir))
+ (choice
+ ,@(mapcar
+ (lambda (el) (list 'const (intern (car el))))
+ (eieio-build-class-alist 'gnus-search-engine t))))))
+
+;;; Transforming and running search queries.
+
+(cl-defgeneric gnus-search-run-search (engine server query groups)
+ "Run QUERY in GROUPS against SERVER, using search ENGINE.
+Should return results as a vector of vectors.")
+
+(cl-defgeneric gnus-search-transform (engine expression)
+ "Transform sexp EXPRESSION into a string search query usable by ENGINE.
+Responsible for handling and, or, and parenthetical expressions.")
+
+(cl-defgeneric gnus-search-transform-expression (engine expression)
+ "Transform a basic EXPRESSION into a string usable by ENGINE.")
+
+(cl-defgeneric gnus-search-make-query-string (engine query-spec)
+ "Extract the actual query string to use from QUERY-SPEC.")
+
+;; Methods that are likely to be the same for all engines.
+
+(cl-defmethod gnus-search-make-query-string ((engine gnus-search-engine)
+ query-spec)
+ (if (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec))
+ (null (slot-value engine 'raw-queries-p)))
+ (gnus-search-transform
+ engine (alist-get 'parsed-query query-spec))
+ (alist-get 'query query-spec)))
+
+(defsubst gnus-search-single-p (query)
+ "Return t if QUERY is a search for a single message."
+ (let ((q (alist-get 'parsed-query query)))
+ (and (= (length q ) 1)
+ (consp (car-safe q))
+ (eq (caar q) 'id))))
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-engine)
+ (query list))
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (gnus-search-transform-expression engine item)))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+;; Most search engines just pass through plain strings.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (expr string))
+ expr)
+
+;; Most search engines use implicit ANDs.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (_expr (eql and)))
+ nil)
+
+;; Most search engines use explicit infixed ORs.
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ ;; Unhandled keywords return a nil; don't create an "or" expression
+ ;; unless both sub-expressions are non-nil.
+ (if (and left right)
+ (format "%s or %s" left right)
+ (or left right))))
+
+;; Most search engines just use the string "not"
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head not)))
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (when next
+ (format "not %s" next))))
+
+;;; Search Engine Interfaces:
+
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
+;; imap interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
+ srv query groups)
+ (save-excursion
+ (let ((server (cadr (gnus-server-to-method srv)))
+ (gnus-inhibit-demon t)
+ ;; We're using the message id to look for a single message.
+ (single-search (gnus-search-single-p query))
+ (grouplist (or groups (gnus-search-get-active srv)))
+ q-string artlist group)
+ (message "Opening server %s" server)
+ ;; We should only be doing this once, in
+ ;; `nnimap-open-connection', but it's too frustrating to try to
+ ;; get to the server from the process buffer.
+ (with-current-buffer (nnimap-buffer)
+ (setf (slot-value engine 'literal-plus)
+ (when (nnimap-capability "LITERAL+") t))
+ ;; MULTISEARCH not yet implemented.
+ (setf (slot-value engine 'multisearch)
+ (when (nnimap-capability "MULTISEARCH") t))
+ ;; FUZZY only partially supported: the command is sent to the
+ ;; server (and presumably acted upon), but we don't yet
+ ;; request a RELEVANCY score as part of the response.
+ (setf (slot-value engine 'fuzzy)
+ (when (nnimap-capability "SEARCH=FUZZY") t)))
+
+ (setq q-string
+ (gnus-search-make-query-string engine query))
+
+ ;; If it's a thread query, make sure that all message-id
+ ;; searches are also references searches.
+ (when (alist-get 'thread query)
+ (setq q-string
+ (replace-regexp-in-string
+ "HEADER Message-Id \\([^ )]+\\)"
+ "(OR HEADER Message-Id \\1 HEADER References \\1)"
+ q-string)))
+
+ (while (and (setq group (pop grouplist))
+ (or (null single-search) (null artlist)))
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((result
+ (gnus-search-imap-search-command engine q-string)))
+ (when (car result)
+ (setq artlist
+ (vconcat
+ (mapcar
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (vector group artn 100))))
+ (cdr (assoc "SEARCH" (cdr result))))
+ artlist))))
+ (message "Searching %s...done" group))))
+ artlist)))
+
+(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
+ (query string))
+ "Create the IMAP search command for QUERY.
+Currenly takes into account support for the LITERAL+ capability.
+Other capabilities could be tested here."
+ (with-slots (literal-plus) engine
+ (when literal-plus
+ (setq query (split-string query "\n")))
+ (cond
+ ((consp query)
+ ;; We're not really streaming, just need to prevent
+ ;; `nnimap-send-command' from waiting for a response.
+ (let* ((nnimap-streaming t)
+ (call
+ (nnimap-send-command
+ "UID SEARCH CHARSET UTF-8 %s"
+ (pop query))))
+ (dolist (l query)
+ (process-send-string (get-buffer-process (current-buffer)) l)
+ (process-send-string (get-buffer-process (current-buffer))
+ (if (nnimap-newlinep nnimap-object)
+ "\n"
+ "\r\n")))
+ (nnimap-get-response call)))
+ (t (nnimap-command "UID SEARCH %s" query)))))
+
+;; TODO: Don't exclude booleans and date keys, just check for them
+;; before checking for general keywords.
+(defvar gnus-search-imap-search-keys
+ '(body cc bcc from header keyword larger smaller subject text to uid)
+ "Known IMAP search keys, excluding booleans and date keys.")
+
+(cl-defmethod gnus-search-transform ((_ gnus-search-imap)
+ (_query null))
+ "ALL")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr string))
+ (unless (string-match-p "\\`/.+/\\'" expr)
+ ;; Also need to check for fuzzy here. Or better, do some
+ ;; refactoring of this stuff.
+ (format "TEXT %s"
+ (gnus-search-imap-handle-string engine expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ (if (and left right)
+ (format "(OR %s %s)"
+ left (format (if (eq 'or (car-safe (nth 2 expr)))
+ "(%s)" "%s")
+ right))
+ (or left right))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head near)))
+ "Imap searches interpret \"near\" as \"or\"."
+ (setcar expr 'or)
+ (gnus-search-transform-expression engine expr))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head not)))
+ "Transform IMAP NOT.
+If the term to be negated is a flag, then use the appropriate UN*
+boolean instead."
+ (if (eql (caadr expr) 'mark)
+ (if (string= (cdadr expr) "new")
+ "OLD"
+ (format "UN%s" (gnus-search-imap-handle-flag (cdadr expr))))
+ (format "NOT %s"
+ (gnus-search-transform-expression engine (cadr expr)))))
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-imap)
+ (expr (head mark)))
+ (gnus-search-imap-handle-flag (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr list))
+ "Handle a search keyword for IMAP.
+All IMAP search keywords that take a value are supported
+directly. Keywords that are boolean are supported through other
+means (usually the \"mark\" keyword)."
+ (let ((fuzzy-supported (slot-value engine 'fuzzy))
+ (fuzzy ""))
+ (cl-case (car expr)
+ (date (setcar expr 'on))
+ (tag (setcar expr 'keyword))
+ (sender (setcar expr 'from)))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eq (car expr) 'recipient)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr)))))
+ ((eq (car expr) 'address)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "from:%s or to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr) (cdr expr)))))
+ ((memq (car expr) '(before since on sentbefore senton sentsince))
+ ;; Ignore dates given as strings.
+ (when (listp (cdr expr))
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-date engine (cdr expr)))))
+ ((stringp (cdr expr))
+ ;; If the search term starts or ends with "*", remove the
+ ;; asterisk. If the engine supports FUZZY, then additionally make
+ ;; the search fuzzy.
+ (when (string-match "\\`\\*\\|\\*\\'" (cdr expr))
+ (setcdr expr (replace-regexp-in-string
+ "\\`\\*\\|\\*\\'" "" (cdr expr)))
+ (when fuzzy-supported
+ (setq fuzzy "FUZZY ")))
+ ;; If the search term is a regexp, drop the expression altogether.
+ (unless (string-match-p "\\`/.+/\\'" (cdr expr))
+ (cond
+ ((memq (car expr) gnus-search-imap-search-keys)
+ (format "%s%s %s"
+ fuzzy
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-string engine (cdr expr))))
+ ((eq (car expr) 'id)
+ (format "HEADER Message-ID \"%s\"" (cdr expr)))
+ ;; Treat what can't be handled as a HEADER search. Probably a bad
+ ;; idea.
+ (t (format "%sHEADER %s %s"
+ fuzzy
+ (car expr)
+ (gnus-search-imap-handle-string engine (cdr expr))))))))))
+
+(cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap)
+ (date list))
+ "Turn DATE into a date string recognizable by IMAP.
+While other search engines can interpret partially-qualified
+dates such as a plain \"January\", IMAP requires an absolute
+date.
+
+DATE is a list of (dd mm yyyy), any element of which could be
+nil. Massage those numbers into the most recent past occurrence
+of whichever date elements are present."
+ (let ((now (decode-time (current-time))))
+ ;; Set nil values to 1, current-month, current-year, or else 1, 1,
+ ;; current-year, depending on what we think the user meant.
+ (unless (seq-elt date 1)
+ (setf (seq-elt date 1)
+ (if (seq-elt date 0)
+ (seq-elt now 4)
+ 1)))
+ (unless (seq-elt date 0)
+ (setf (seq-elt date 0) 1))
+ (unless (seq-elt date 2)
+ (setf (seq-elt date 2)
+ (seq-elt now 5)))
+ ;; Fiddle with the date until it's in the past. There
+ ;; must be a way to combine all these steps.
+ (unless (< (seq-elt date 2)
+ (seq-elt now 5))
+ (when (< (seq-elt now 3)
+ (seq-elt date 0))
+ (cl-decf (seq-elt date 1)))
+ (cond ((zerop (seq-elt date 1))
+ (setf (seq-elt date 1) 1)
+ (cl-decf (seq-elt date 2)))
+ ((< (seq-elt now 4)
+ (seq-elt date 1))
+ (cl-decf (seq-elt date 2))))))
+ (format-time-string "%e-%b-%Y" (apply #'encode-time
+ (append '(0 0 0)
+ date))))
+
+(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
+ (str string))
+ (with-slots (literal-plus) engine
+ (if (multibyte-string-p str)
+ ;; If LITERAL+ is available, use it and encode string as
+ ;; UTF-8.
+ (if literal-plus
+ (format "{%d+}\n%s"
+ (string-bytes str)
+ (encode-coding-string str 'utf-8))
+ ;; Otherwise, if the user hasn't already quoted the string,
+ ;; quote it for them.
+ (if (string-prefix-p "\"" str)
+ str
+ (format "\"%s\"" str)))
+ str)))
+
+(defun gnus-search-imap-handle-flag (flag)
+ "Make sure string FLAG is something IMAP will recognize."
+ ;; What else? What about the KEYWORD search key?
+ (setq flag
+ (pcase flag
+ ("flag" "flagged")
+ ("read" "seen")
+ (_ flag)))
+ (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
+ (upcase flag)
+ ""))
+
+;;; Methods for the indexed search engines.
+
+;; First, some common methods.
+
+(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups)
+ "Parse the results of ENGINE's query against SERVER in GROUPS.
+Locally-indexed search engines return results as a list of
+filenames, sometimes with additional information. Returns a list
+of viable results, in the form of a list of [group article score]
+vectors.")
+
+(cl-defgeneric gnus-search-index-extract (engine)
+ "Extract a single article result from the current buffer.
+Returns a list of two values: a file name, and a relevancy score.
+Advances point to the beginning of the next result.")
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-indexed)
+ server query groups)
+ "Run QUERY against SERVER using ENGINE.
+This method is common to all indexed search engines.
+
+Returns a list of [group article score] vectors."
+
+ (save-excursion
+ (let* ((qstring (gnus-search-make-query-string engine query))
+ (program (slot-value engine 'program))
+ (buffer (slot-value engine 'proc-buffer))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ proc exitstatus)
+ (set-buffer buffer)
+ (erase-buffer)
+
+ (if groups
+ (message "Doing %s query on %s..." program groups)
+ (message "Doing %s query..." program))
+ (setq proc (apply #'start-process (format "search-%s" server)
+ buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (setq exitstatus (process-exit-status proc))
+ (if (zerop exitstatus)
+ ;; The search results have been put into the current buffer;
+ ;; `parse-output' finds them there and returns the article
+ ;; list.
+ (gnus-search-indexed-parse-output engine server query groups)
+ (nnheader-report 'search "%s error: %s" program exitstatus)
+ ;; Failure reason is in this buffer, show it if the user
+ ;; wants it.
+ (when (> gnus-verbose 6)
+ (display-buffer buffer))
+ nil))))
+
+(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
+ server query &optional groups)
+ (let ((prefix (slot-value engine 'remove-prefix))
+ (group-regexp (when groups
+ (regexp-opt
+ (mapcar
+ (lambda (x) (gnus-group-real-name x))
+ groups))))
+ artlist vectors article group)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
+ (when (and (file-readable-p f-name)
+ (null (file-directory-p f-name))
+ (or (null groups)
+ (and (gnus-search-single-p query)
+ (alist-get 'thread query))
+ (string-match-p group-regexp f-name)))
+ (push (list f-name score) artlist))))
+ ;; Are we running an additional grep query?
+ (when-let ((grep-reg (alist-get 'grep query)))
+ (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
+ ;; Turn (file-name score) into [group article score].
+ (pcase-dolist (`(,f-name ,score) artlist)
+ (setq article (file-name-nondirectory f-name))
+ ;; Remove prefix.
+ (when (and prefix
+ (file-name-absolute-p prefix)
+ (string-match (concat "^"
+ (file-name-as-directory prefix))
+ f-name))
+ (setq group (replace-match "" t t (file-name-directory f-name))))
+ ;; Break the directory name down until it's something that
+ ;; (probably) can be used as a group name.
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "^[./\\]" ""
+ group nil t)
+ nil t)
+ nil t))
+
+ (push (vector (gnus-group-full-name group server)
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-match ":" article))
+ group nil))
+ (if (numberp score)
+ score
+ (string-to-number score)))
+ vectors))
+ vectors))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
+ "Base implementation treats the whole line as a filename, and
+fudges a relevancy score of 100."
+ (prog1
+ (list (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ 100)
+ (forward-line 1)))
+
+;; Swish++
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Untested and likely wrong.
+ ((and (stringp (cdr expr))
+ (string-prefix-p "(" (cdr expr)))
+ (format "%s = %s" (car expr) (gnus-search-transform
+ engine
+ (gnus-search-parse-query (cdr expr)))))
+ (t (format "%s = %s" (car expr) (cdr expr)))))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish++)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (config-file switches) engine
+ `("--config-file" ,config-file
+ ,@switches
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish++))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
+ (list (match-string 2)
+ (match-string 1))))
+
+;; Swish-e
+
+;; I didn't do the query transformation for Swish-e, because the
+;; program seems no longer to exist.
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish-e)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (index-files switches) engine
+ `("-f" ,@index-files
+ ,@switches
+ "-w"
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish-e))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
+ (list (match-string 3)
+ (match-string 1))))
+
+;; Namazu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-namazu)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'body)
+ (cadr expr))
+ ;; I have no idea which fields namazu can handle. Just do these
+ ;; for now.
+ ((memq (car expr) '(subject from to))
+ (format "+%s:%s" (car expr) (cdr expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eq (car expr) 'id)
+ (format "+message-id:%s" (cdr expr)))
+ (t (ignore-errors (cl-call-next-method)))))
+
+;; I can't tell if this is actually necessary.
+(cl-defmethod gnus-search-run-search :around ((_e gnus-search-namazu)
+ _server _query _groups)
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "LC_MESSAGES" "C")
+ (cl-call-next-method)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-namazu)
+ (qstring string)
+ query &optional _groups)
+ (let ((max (alist-get 'limit query)))
+ (with-slots (switches index-directory) engine
+ (append
+ (list "-q" ; don't be verbose
+ "-a" ; show all matches
+ "-s") ; use short format
+ (when max (list (format "--max=%d" max)))
+ switches
+ (list qstring index-directory)))))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-namazu))
+ "Extract a single message result for Namazu.
+Namazu provides a little more information, for instance a score."
+
+ (when (re-search-forward
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ nil t)
+ (list (match-string 4)
+ (match-string 3))))
+
+;;; Notmuch interface
+
+(cl-defmethod gnus-search-transform ((_engine gnus-search-notmuch)
+ (_query null))
+ "*")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr list))
+ ;; Swap keywords as necessary.
+ (cl-case (car expr)
+ (sender (setcar expr 'from))
+ ;; Notmuch's "to" is already equivalent to our "recipient".
+ (recipient (setcar expr 'to))
+ (mark (setcar expr 'tag)))
+ ;; Then actually format the results.
+ (cl-flet ((notmuch-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))
+ (`(,d ,m nil)
+ (format "%02d-%02d" d m))
+ (`(nil ,m ,y)
+ (format "%02d-%d" m y))
+ (`(,d ,m ,y)
+ (format "%d/%d/%d" m d y))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eql (car expr) 'body)
+ (cdr expr))
+ ((memq (car expr) '(from to subject attachment mimetype tag id
+ thread folder path lastmod query property))
+ ;; Notmuch requires message-id with no angle brackets.
+ (when (eql (car expr) 'id)
+ (setcdr
+ expr (replace-regexp-in-string "\\`<\\|>\\'" "" (cdr expr))))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ ;; Notmuch can only handle trailing asterisk
+ ;; wildcards, so strip leading asterisks.
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (notmuch-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch)
+ server query groups)
+ "Handle notmuch's thread-search routine."
+ ;; Notmuch allows for searching threads, but only using its own
+ ;; thread ids. That means a thread search is a \"double-bounce\":
+ ;; once to find the relevant thread ids, and again to find the
+ ;; actual messages. This method performs the first \"bounce\".
+ (if (alist-get 'thread query)
+ (with-slots (program proc-buffer) engine
+ (let* ((qstring
+ (gnus-search-make-query-string engine query))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ thread-ids proc)
+ (set-buffer proc-buffer)
+ (erase-buffer)
+ (setq proc (apply #'start-process (format "search-%s" server)
+ proc-buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
+ (push (match-string 1) thread-ids))
+ (cl-call-next-method
+ engine server
+ ;; Completely replace the query with our new thread-based one.
+ (mapconcat (lambda (thrd) (concat "thread:" thrd))
+ thread-ids " or ")
+ nil)))
+ (cl-call-next-method engine server query groups)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch)
+ (qstring string)
+ query &optional _groups)
+ ;; Theoretically we could use the GROUPS parameter to pass a
+ ;; --folder switch to notmuch, but I'm not confident of getting the
+ ;; format right.
+ (let ((limit (alist-get 'limit query))
+ (thread (alist-get 'thread query)))
+ (with-slots (switches config-file) engine
+ `(,(format "--config=%s" config-file)
+ "search"
+ ,(if thread
+ "--output=threads"
+ "--output=files")
+ "--duplicate=1" ; I have found this necessary, I don't know why.
+ ,@switches
+ ,(if limit (format "--limit=%d" limit) "")
+ ,qstring
+ ))))
+
+;;; Mairix interface
+
+;; See the Gnus manual for why mairix searching is a bit weird.
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-mairix)
+ (query list))
+ "Transform QUERY for a Mairix engine.
+Because Mairix doesn't accept parenthesized expressions, nor
+\"or\" statements between different keys, results may differ from
+other engines. We unpeel parenthesized expressions, and just
+cross our fingers for the rest of it."
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (if (consp (car-safe item))
+ (gnus-search-transform engine item)
+ (gnus-search-transform-expression engine item))))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head not)))
+ "Transform Mairix \"not\".
+Mairix negation requires a \"~\" preceding string search terms,
+and \"-\" before marks."
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (replace-regexp-in-string
+ ":"
+ (if (eql (caadr expr) 'mark)
+ ":-"
+ ":~")
+ next)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head or)))
+ "Handle Mairix \"or\" statement.
+Mairix only accepts \"or\" expressions on homogenous keys. We
+cast \"or\" expressions on heterogenous keys as \"and\", which
+isn't quite right, but it's the best we can do. For date keys,
+only keep one of the terms."
+ (let ((term1 (caadr expr))
+ (term2 (caaddr expr))
+ (val1 (gnus-search-transform-expression engine (nth 1 expr)))
+ (val2 (gnus-search-transform-expression engine (nth 2 expr))))
+ (cond
+ ((or (listp term1) (listp term2))
+ (concat val1 " " val2))
+ ((and (member (symbol-name term1) gnus-search-date-keys)
+ (member (symbol-name term2) gnus-search-date-keys))
+ (or val1 val2))
+ ((eql term1 term2)
+ (if (and val1 val2)
+ (format "%s/%s"
+ val1
+ (nth 1 (split-string val2 ":")))
+ (or val1 val2)))
+ (t (concat val1 " " val2)))))
+
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-mairix)
+ (expr (head mark)))
+ (gnus-search-mairix-handle-mark (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr list))
+ (let ((key (cl-case (car expr)
+ (sender "f")
+ (from "f")
+ (to "t")
+ (cc "c")
+ (subject "s")
+ (id "m")
+ (body "b")
+ (address "a")
+ (recipient "tc")
+ (text "bs")
+ (attachment "n")
+ (t nil))))
+ (cond
+ ((consp (car expr))
+ (gnus-search-transform engine expr))
+ ((member (symbol-name (car expr)) gnus-search-date-keys)
+ (gnus-search-mairix-handle-date expr))
+ ((memq (car expr) '(size smaller larger))
+ (gnus-search-mairix-handle-size expr))
+ ;; Drop regular expressions.
+ ((string-match-p "\\`/" (cdr expr))
+ nil)
+ ;; Turn parenthesized phrases into multiple word terms. Again,
+ ;; this isn't quite what the user is asking for, but better to
+ ;; return false positives.
+ ((and key (string-match-p "[[:blank:]]" (cdr expr)))
+ (mapconcat
+ (lambda (s) (format "%s:%s" key s))
+ (split-string (gnus-search-mairix-treat-string
+ (cdr expr)))
+ " "))
+ (key (format "%s:%s" key
+ (gnus-search-mairix-treat-string
+ (cdr expr))))
+ (t nil))))
+
+(defun gnus-search-mairix-treat-string (str)
+ "Treat string for wildcards.
+Mairix accepts trailing wildcards, but not leading. Also remove
+double quotes."
+ (replace-regexp-in-string
+ "\\`\\*\\|\"" ""
+ (replace-regexp-in-string "\\*\\'" "=" str)))
+
+(defun gnus-search-mairix-handle-size (expr)
+ "Format a mairix size search.
+Assume \"size\" key is equal to \"larger\"."
+ (format
+ (if (eql (car expr) 'smaller)
+ "z:-%s"
+ "z:%s-")
+ (cdr expr)))
+
+(defun gnus-search-mairix-handle-mark (expr)
+ "Format a mairix mark search."
+ (let ((mark
+ (pcase (cdr expr)
+ ("flag" "f")
+ ("read" "s")
+ ("seen" "s")
+ ("replied" "r")
+ (_ nil))))
+ (when mark
+ (format "F:%s" mark))))
+
+(defun gnus-search-mairix-handle-date (expr)
+ (let ((str
+ (pcase (cdr expr)
+ (`(nil ,m nil)
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%s%02d"
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)
+ d))
+ (`(nil ,m ,y)
+ (format "%d%s"
+ y (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)))
+ (`(,d ,m ,y)
+ (format "%d%02d%02d" y m d)))))
+ (format
+ (pcase (car expr)
+ ('date "d:%s")
+ ('since "d:%s-")
+ ('after "d:%s-")
+ ('before "d:-%s"))
+ str)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mairix)
+ (qstring string)
+ query &optional _groups)
+ (with-slots (switches config-file) engine
+ (append `("--rcfile" ,config-file "-r")
+ switches
+ (when (alist-get 'thread query) (list "-t"))
+ (list qstring))))
+
+;;; Find-grep interface
+
+(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
+ (_ list))
+ ;; Drop everything that isn't a plain string.
+ nil)
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-find-grep)
+ server query
+ &optional groups)
+ "Run find and grep to obtain matching articles."
+ (let* ((method (gnus-server-to-method server))
+ (sym (intern
+ (concat (symbol-name (car method)) "-directory")))
+ (directory (cadr (assoc sym (cddr method))))
+ (regexp (alist-get 'grep query))
+ (grep-options (slot-value engine 'grep-options))
+ (grouplist (or groups (gnus-search-get-active server)))
+ (buffer (slot-value engine 'proc-buffer)))
+ (unless directory
+ (error "No directory found in method specification of server %s"
+ server))
+ (apply
+ 'vconcat
+ (mapcar (lambda (x)
+ (let ((group x)
+ artlist)
+ (message "Searching %s using find-grep..."
+ (or group server))
+ (save-window-excursion
+ (set-buffer buffer)
+ (if (> gnus-verbose 6)
+ (pop-to-buffer (current-buffer)))
+ (cd directory) ; Using relative paths simplifies
+ ; postprocessing.
+ (let ((group
+ (if (not group)
+ "."
+ ;; Try accessing the group literally as
+ ;; well as interpreting dots as directory
+ ;; separators so the engine works with
+ ;; plain nnml as well as the Gnus Cache.
+ (let ((group (gnus-group-real-name group)))
+ ;; Replace cl-func find-if.
+ (if (file-directory-p group)
+ group
+ (if (file-directory-p
+ (setq group
+ (replace-regexp-in-string
+ "\\." "/"
+ group nil t)))
+ group))))))
+ (unless group
+ (error "Cannot locate directory for group"))
+ (save-excursion
+ (apply
+ 'call-process "find" nil t
+ "find" group "-maxdepth" "1" "-type" "f"
+ "-name" "[0-9]*" "-exec"
+ (slot-value engine 'grep-program)
+ `("-l" ,@(and grep-options
+ (split-string grep-options "\\s-" t))
+ "-e" ,regexp "{}" "+"))))
+
+ ;; Translate relative paths to group names.
+ (while (not (eobp))
+ (let* ((path (split-string
+ (buffer-substring
+ (point)
+ (line-end-position)) "/" t))
+ (art (string-to-number (car (last path)))))
+ (while (string= "." (car path))
+ (setq path (cdr path)))
+ (let ((group (mapconcat #'identity
+ (cl-subseq path 0 -1)
+ ".")))
+ (push
+ (vector (gnus-group-full-name group server) art 0)
+ artlist))
+ (forward-line 1)))
+ (message "Searching %s using find-grep...done"
+ (or group server))
+ artlist)))
+ grouplist))))
+
+(declare-function mm-url-insert "mm-url" (url &optional follow-refresh))
+(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs))
+
+;; gmane interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-gmane)
+ srv query &optional groups)
+ "Run a search against a gmane back-end server."
+ (let* ((case-fold-search t)
+ (groupspec (mapconcat
+ (lambda (x)
+ (if (string-match-p "gmane" x)
+ (format "group:%s" (gnus-group-short-name x))
+ (error "Can't search non-gmane groups: %s" x)))
+ groups " "))
+ (buffer (slot-value engine 'proc-buffer))
+ (search (concat (gnus-search-make-query-string engine query)
+ " "
+ groupspec))
+ (gnus-inhibit-demon t)
+ artlist)
+ (require 'mm-url)
+ (with-current-buffer buffer
+ (erase-buffer)
+ (mm-url-insert
+ (concat
+ "http://search.gmane.org/nov.php"
+ "?"
+ (mm-url-encode-www-form-urlencoded
+ `(("query" . ,search)
+ ("HITSPERPAGE" . "999")))))
+ (set-buffer-multibyte t)
+ (decode-coding-region (point-min) (point-max) 'utf-8)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (not (eobp))
+ (unless (or (eolp) (looking-at "\x0d"))
+ (let ((header (nnheader-parse-nov)))
+ (let ((xref (mail-header-xref header))
+ (xscore (string-to-number (cdr (assoc 'X-Score
+ (mail-header-extra header))))))
+ (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
+ (push
+ (vector
+ (gnus-group-prefixed-name (match-string 1 xref) srv)
+ (string-to-number (match-string 2 xref)) xscore)
+ artlist)))))
+ (forward-line 1)))
+ (apply #'vector (nreverse (delete-dups artlist)))))
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head near)))
+ nil)
+
+;; Can Gmane handle OR or NOT keywords?
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head or)))
+ nil)
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head not)))
+ nil)
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (expr list))
+ "The only keyword value gmane can handle is author, ie from."
+ (cond
+ ((memq (car expr) '(from sender author address))
+ (format "author:%s" (cdr expr)))
+ ((eql (car expr) 'body)
+ (cdr expr))))
+
+;;; Util Code:
+
+(defun gnus-search-run-query (specs)
+ "Invoke appropriate search engine function."
+ ;; For now, run the searches synchronously. At some point
+ ;; multiple-server searches can each be run in their own thread,
+ ;; allowing concurrent searches of multiple backends. At present
+ ;; this causes problems when searching more than one server that
+ ;; uses `nntp-server-buffer', as their return values are written
+ ;; interleaved into that buffer. Anyway, that's the reason for the
+ ;; `mapc'.
+ (let* ((results [])
+ (prepared-query (gnus-search-prepare-query
+ (alist-get 'search-query-spec specs)))
+ (limit (alist-get 'limit prepared-query)))
+ (mapc
+ (pcase-lambda (`(,server . ,groups))
+ (let ((search-engine (gnus-search-server-to-engine server)))
+ (setq results
+ (vconcat
+ (gnus-search-run-search
+ search-engine server prepared-query groups)
+ results))))
+ (alist-get 'search-group-spec specs))
+ ;; Some search engines do their own limiting, but some don't, so
+ ;; do it again here. This is bad because, if the user is
+ ;; searching multiple groups, they would reasonably expect the
+ ;; limiting to apply to the search results *after sorting*. Doing
+ ;; it this way is liable to, for instance, eliminate all results
+ ;; from a later group entirely.
+ (if limit
+ (seq-subseq results 0 (min limit (length results)))
+ results)))
+
+(defun gnus-search-prepare-query (query-spec)
+ "Accept a search query in raw format, and prepare it.
+QUERY-SPEC is an alist produced by functions such as
+`gnus-group-make-search-group', and contains at least a 'query
+key, and possibly some meta keys. This function extracts any
+additional meta keys from the 'query string, and parses the
+remaining string, then adds all that to the top-level spec."
+ (let ((query (alist-get 'query query-spec))
+ val)
+ (when (stringp query)
+ ;; Look for these meta keys:
+ (while (string-match
+ "\\(thread\\|grep\\|limit\\|raw\\):\\([^ ]+\\)"
+ query)
+ (setq val (match-string 2 query))
+ (setf (alist-get (intern (match-string 1 query)) query-spec)
+ ;; This is stupid.
+ (cond
+ ((equal val "t"))
+ ((null (zerop (string-to-number val)))
+ (string-to-number val))
+ (t val)))
+ (setq query
+ (string-trim (replace-match "" t t query 0)))
+ (setf (alist-get 'query query-spec) query)))
+ (when gnus-search-use-parsed-queries
+ (setf (alist-get 'parsed-query query-spec)
+ (gnus-search-parse-query query)))
+ query-spec))
+
+;; This should be done once at Gnus startup time, when the servers are
+;; first opened, and the resulting engine instance attached to the
+;; server.
+(defun gnus-search-server-to-engine (srv)
+ (let* ((method (gnus-server-to-method srv))
+ (server
+ (or (assoc 'gnus-search-engine (cddr method))
+ (assoc (car method) gnus-search-default-engines)
+ (when-let ((old (assoc 'nnir-search-engine
+ (cddr method))))
+ (nnheader-message
+ 8 "\"nnir-search-engine\" is no longer a valid parameter")
+ (pcase old
+ ('notmuch 'gnus-search-notmuch)
+ ('namazu 'gnus-search-namazu)
+ ('find-grep 'gnus-search-find-grep)))))
+ (inst
+ (cond
+ ((null server) nil)
+ ((eieio-object-p (cadr server))
+ (cadr server))
+ ((class-p (cadr server))
+ (make-instance (cadr server)))
+ (t nil))))
+ (if inst
+ (when (cddr server)
+ (pcase-dolist (`(,key ,value) (cddr server))
+ (condition-case nil
+ (setf (slot-value inst key) value)
+ ((invalid-slot-name invalid-slot-type)
+ (nnheader-message
+ 5 "Invalid search engine parameter: (%s %s)"
+ key value)))))
+ (nnheader-message 5 "No search engine defined for %s" srv))
+ inst))
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-search-thread (header)
+ "Make an nnselect group based on the thread containing the article
+header. The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server
+ (cl-pushnew (list registry-server) server :test #'equal))
+ (gnus-group-make-search-group nil (list
+ (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+(defun gnus-search-get-active (srv)
+ (let ((method (gnus-server-to-method srv))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null gnus-search-ignored-newsgroups)
+ (string= gnus-search-ignored-newsgroups ""))
+ (delete-matching-lines gnus-search-ignored-newsgroups))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
+ groups))
+ (forward-line)))))
+ groups))
+
+(defvar gnus-search-minibuffer-map
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km minibuffer-local-map)
+ (define-key km (kbd "SPC") #'self-insert-command)
+ (define-key km (kbd "TAB") #'gnus-search-complete-key)
+ km))
+
+(defun gnus-search-complete-key ()
+ "Complete a search key at point.
+Used when reading a search query from the minibuffer."
+ (interactive)
+ (when (completion-in-region
+ (save-excursion
+ (if (re-search-backward " " (minibuffer-prompt-end) t)
+ (1+ (point))
+ (minibuffer-prompt-end)))
+ (point) gnus-search-expandable-keys)
+ (insert ":")))
+
+(defun gnus-search-make-spec (arg)
+ (list (cons 'query
+ (read-from-minibuffer
+ "Query: " nil gnus-search-minibuffer-map
+ nil 'gnus-search-history))
+ (cons 'raw arg)))
+
+(provide 'gnus-search)
+;;; gnus-search.el ends here
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 21206b683c..ce2e99de05 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -36,10 +36,10 @@
;; sorting. Most functions will just chose a fixed number, such as
;; 100, for this score.
-;; For example the search function `nnir-run-query' applied to
-;; arguments specifying a search query (see "nnir.el") can be used to
-;; return a list of articles from a search. Or the function can be the
-;; identity and the args a vector of articles.
+;; For example the search function `gnus-search-run-query' applied to
+;; arguments specifying a search query (see "gnus-search.el") can be
+;; used to return a list of articles from a search. Or the function
+;; can be the identity and the args a vector of articles.
;;; Code:
@@ -47,7 +47,7 @@
;;; Setup:
(require 'gnus-art)
-(require 'nnir)
+(require 'gnus-search)
(eval-when-compile (require 'cl-lib))
@@ -372,25 +372,25 @@ nnselect-request-article
;; find the servers for a pseudo-article
(if (eq 'nnselect (car (gnus-server-to-method server)))
(with-current-buffer gnus-summary-buffer
- (let ((thread (gnus-id-to-thread article)))
+ (let ((thread (gnus-id-to-thread article)))
(when thread
(mapc
- #'(lambda (x)
- (when (and x (> x 0))
- (cl-pushnew
- (list
- (gnus-method-to-server
- (gnus-find-method-for-group
- (nnselect-article-group x)))) servers :test 'equal)))
+ (lambda (x)
+ (when (and x (> x 0))
+ (cl-pushnew
+ (list
+ (gnus-method-to-server
+ (gnus-find-method-for-group
+ (nnselect-article-group x)))) servers :test 'equal)))
(gnus-articles-in-thread thread)))))
(setq servers (list (list server))))
(setq artlist
- (nnir-run-query
+ (gnus-search-run-query
(list
- (cons 'nnir-query-spec
- (list (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "") (cons 'shortcut t)))
- (cons 'nnir-group-spec servers))))
+ (cons 'search-query-spec
+ (list (cons 'query `((id . ,article)))
+ (cons 'criteria "") (cons 'shortcut t)))
+ (cons 'search-group-spec servers))))
(unless (zerop (nnselect-artlist-length artlist))
(setq
group-art
@@ -603,26 +603,35 @@ nnselect-request-thread
(cl-some #'(lambda (x)
(when (and x (> x 0)) x))
(gnus-articles-in-thread thread)))))))))
- ;; Check if we are dealing with an imap backend.
- (if (eq 'nnimap
- (car (gnus-find-method-for-group artgroup)))
+ ;; Check if search-based thread referral is permitted, and
+ ;; available.
+ (if (and gnus-refer-thread-use-search
+ (gnus-search-server-to-engine
+ (gnus-method-to-server
+ (gnus-find-method-for-group artgroup))))
;; If so we perform the query, massage the result, and return
;; the new headers back to the caller to incorporate into the
;; current summary buffer.
(let* ((group-spec
(list (delq nil (list
(or server (gnus-group-server artgroup))
- (unless gnus-refer-thread-use-search
+ (unless gnus-refer-thread-use-search
artgroup)))))
+ (ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
(query-spec
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(last (nnselect-artlist-length gnus-newsgroup-selection))
(first (1+ last))
(new-nnselect-artlist
- (nnir-run-query
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))
old-arts seq
headers)
(mapc
@@ -670,7 +679,7 @@ nnselect-request-thread
group
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
headers)
- ;; If not an imap backend just warp to the original article
+ ;; If we can't or won't use search, just warp to the original
;; group and punt back to gnus-summary-refer-thread.
(and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
@@ -768,9 +777,15 @@ nnselect-search-thread
The current server will be searched. If the registry is
installed, the server that the registry reports the current
article came from is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(server
(list (list (gnus-method-to-server
(gnus-find-method-for-group gnus-newsgroup-name)))))
@@ -794,10 +809,10 @@ nnselect-search-thread
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))))
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))))
(cons 'nnselect-artlist nil)))
(gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
@@ -929,18 +944,18 @@ nnselect-push-info
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-(defun gnus-summary-make-search-group (nnir-extra-parms)
+(defun gnus-summary-make-search-group (no-parse)
"Search a group from the summary buffer.
-Pass NNIR-EXTRA-PARMS on to the search engine."
+Pass NO-PARSE on to the search engine."
(interactive "P")
(gnus-warp-to-article)
(let ((spec
(list
- (cons 'nnir-group-spec
+ (cons 'search-group-spec
(list (list
(gnus-group-server gnus-newsgroup-name)
gnus-newsgroup-name))))))
- (gnus-group-make-search-group nnir-extra-parms spec)))
+ (gnus-group-make-search-group no-parse spec)))
;; The end.
diff --git a/test/lisp/gnus/search-tests.el b/test/lisp/gnus/search-tests.el
new file mode 100644
index 0000000000..7c0a856900
--- /dev/null
+++ b/test/lisp/gnus/search-tests.el
@@ -0,0 +1,99 @@
+;;; gnus-search-tests.el --- Tests for Gnus' search routines -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for the search parsing, search engines, and their
+;; transformations.
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-search)
+
+(ert-deftest gnus-s-parse ()
+ "Test basic structural parsing."
+ (let ((pairs
+ '(("string" . ("string"))
+ ("from:john" . ((from . "john")))
+ ("here and there" . ("here" and "there"))
+ ("here or there" . ((or "here" "there")))
+ ("here (there or elsewhere)" . ("here" ((or "there" "elsewhere"))))
+ ("here not there" . ("here" (not "there")))
+ ("from:boss or not vacation" . ((or (from . "boss") (not "vacation")))))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-parse-query (car p)) (cdr p))))))
+
+(ert-deftest gnus-s-expand-keyword ()
+ "Test expansion of keywords"
+ (let ((gnus-search-expandable-keys
+ (default-value 'gnus-search-expandable-keys))
+ (pairs
+ '(("su" . "subject")
+ ("f" . "from")
+ ("co-f" . "contact-from"))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-expand-key (car p))
+ (cdr p))))
+ (should-error (gnus-search-query-expand-key "s")
+ :type 'gnus-search-parse-error)
+ (should-error (gnus-search-query-expand-key "c-f")
+ :type 'gnus-search-parse-error)))
+
+(ert-deftest gnus-s-parse-date ()
+ "Test parsing of date expressions."
+ (let ((rel-date (encode-time 0 0 0 15 4 2017))
+ (pairs
+ '(("January" . (nil 1 nil))
+ ("2017" . (nil nil 2017))
+ ("15" . (15 nil nil))
+ ("January 15" . (15 1 nil))
+ ("tuesday" . (11 4 2017))
+ ("1d" . (14 4 2017))
+ ("1w" . (8 4 2017)))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-parse-date (car p) rel-date)
+ (cdr p))))))
+
+(ert-deftest gnus-s-delimited-string ()
+ "Test proper functioning of `gnus-search-query-return-string'."
+ (with-temp-buffer
+ (insert "one\ntwo words\nthree \"words with quotes\"\n\"quotes at start\"\n/alternate \"quotes\"/\n(more bits)")
+ (goto-char (point-min))
+ (should (string= (gnus-search-query-return-string)
+ "one"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "two"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "three"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "\"")
+ "\"quotes at start\""))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "/")
+ "/alternate \"quotes\"/"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string ")" t)
+ "more bits"))))
+
+(provide 'gnus-search-tests)
+;;; search-tests.el ends here
--
2.29.1
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-01 5:32 ` Eric Abrahamsen
@ 2020-11-01 18:10 ` Basil L. Contovounesios
2020-11-01 18:22 ` Eli Zaretskii
2020-11-01 21:19 ` Eric Abrahamsen
2020-11-01 21:38 ` Eric Abrahamsen
1 sibling, 2 replies; 14+ messages in thread
From: Basil L. Contovounesios @ 2020-11-01 18:10 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: Lars Ingebrigtsen, 44016
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> Finally done! I think. Most of the final work was writing the docs.
Thanks! I only had time to look through the manual, and it looks good,
modulo some minor markup nits.
> +It's possible to search a backend more thoroughly using an associated
> +search engine. Some backends come with their own search engine: IMAP
> +servers, for instance, do their own searching. Other backends, for
> +example a local @code{nnmaildir} installation, might require the user
> +to manually set up some sort of search indexing. Default associations
> +between backends and engines can be defined in
> +@code{gnus-search-default-engines}, and engines can also be defined on
> +a per-backend basis (@xref{Search Engines}).
Should this and other parenthesised xrefs be pxref instead?
(I haven't tested the difference.)
> +Once the search engines are set up, you can search for messages in
> +groups from one or more backends, and show the results in a group.
> +The groups that hold search results are created on the nnselect
> +backend, and can be either ephemeral or persistent (@xref{Creating
> +Search Groups}).
> +
> +@vindex: gnus-search-use-parsed-queries
Is the colon necessary?
> +Search queries can be specified one of two ways: either using the
> +syntax of the engine responsible for the group you're searching, or
> +using Gnus' generalized search syntax. Set the option
> +@code{gnus-search-use-parsed-queries} to a non-nil value to used the
> +generalized syntax. The advantage of this syntax is that, if you have
> +multiple backends indexed by different engines, you don't need to
> +remember which one you're searching -- it's also possible to issue the
I think Texinfo conventionally uses three hyphens for punctuation in
sentences (info "(texinfo) Conventions"). (Here and elsewhere.)
> +same query against multiple groups, indexed by different engines, at
> +the same time. It also provides a few other conveniences including
> +relative date parsing and tie-ins into other Emacs packages. For
> +details on Gnus' query language, @xref{Search Queries}.
I think @xref is used at the start of sentences and @ref at the end.
> +@vindex gnus-search-default-engines
> +The option @code{gnus-search-default-engines} assigns search engines
> +by server type. Its value is an alist mapping symbols indicating a
> +server type (e.g. @code{nnmaildir} or @code{nnml}) to symbols
My impression is that Emacs uses the (US?) convention of following
e.g. with a comma (but I could be wrong). (Here and elsewhere.)
> +These engines have a handful of configuration parameters that can
> +either be set as a default option for all engines of that type, or set
> +per-engine in your server config. These common paramters are:
paramters -> parameters
> +
> +@itemize
> +@item
> +@code{program}: The name of the executable. Defaults to the plain
I think listing definitions, particularly when they need markup, is
better done with e.g. '@table @code' rather than @itemize.
(Here and elsewhere.)
> +program name such as ``notmuch'' or ``namazu''.
Should command names be marked as @command? (Here or elsewhere.)
> +The customization options are formed on the pattern
> +@code{gnus-search-<engine>-<parameter>}. For instance, to use a
Don't know whether it's preferable here, but there's also the
metavariable syntax @code{gnus-search-@var{engine}-@var{parameter}},
with which you can e.g. refer to individual @vars in subsequent prose.
> +non-standard notmuch program, you might set
> +@code{gnus-search-notmuch-program} to ``/usr/local/bin/notmuch''.
@file?
> -By default the whole message will be searched. The query can be limited
> -to a specific part of a message by using a prefix-arg. After inputting
> -the query this will prompt (with completion) for a message part.
> -Choices include ``Whole message'', ``Subject'', ``From'', and
I think literal text (here and elsewhere) is usually written as @samp.
> +(from:john or from:peter) subject: ``lunch tomorrow'' since:3d
I think quoting in examples should use "" instead of ``'' (here and
elsewhere).
> +@item
> +mark: Accepts ``flag'', ``seen'', ``read'' or ``replied'', or any of
> +Gnus' single-letter representations of those marks, i.e. ``mark:R''
i.e. -> e.g.?
> +for ``read''.
> -@end table
> +@vindex gnus-search-contact-sources
> +If an elisp-based contact management packages (e.g. BBDB or EBDB)
packages -> package
elisp -> Elisp?
> -@node Customizations
> -@subsubsection Customizations
> +@vindex gnus-search-date-keys
> +Date-type keys (see @code{gnus-search-date-keys}) will accept a wide
> +variety of values. First, anything that @code{parse-time-string} can
> +parse is acceptable. Dates with missing values will be interpreted as
> +the most recent occurance thereof: for instance ``march 03'' is the
occurance -> occurrence (here and elsewhere)
--
Basil
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-01 18:10 ` Basil L. Contovounesios
@ 2020-11-01 18:22 ` Eli Zaretskii
2020-11-01 21:19 ` Eric Abrahamsen
1 sibling, 0 replies; 14+ messages in thread
From: Eli Zaretskii @ 2020-11-01 18:22 UTC (permalink / raw)
To: Basil L. Contovounesios; +Cc: eric, larsi, 44016
> From: "Basil L. Contovounesios" <contovob@tcd.ie>
> Date: Sun, 01 Nov 2020 18:10:39 +0000
> Cc: Lars Ingebrigtsen <larsi@gnus.org>, 44016@debbugs.gnu.org
>
> > +@vindex: gnus-search-use-parsed-queries
>
> Is the colon necessary?
It's necessary to remove it ;-)
> > +same query against multiple groups, indexed by different engines, at
> > +the same time. It also provides a few other conveniences including
> > +relative date parsing and tie-ins into other Emacs packages. For
> > +details on Gnus' query language, @xref{Search Queries}.
>
> I think @xref is used at the start of sentences and @ref at the end.
Either "see @ref" or "@pxref". Definitely not @xref.
> > +@item
> > +mark: Accepts ``flag'', ``seen'', ``read'' or ``replied'', or any of
> > +Gnus' single-letter representations of those marks, i.e. ``mark:R''
>
> i.e. -> e.g.?
Yes. And @: after "e.g.".
Thanks.
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-01 18:10 ` Basil L. Contovounesios
2020-11-01 18:22 ` Eli Zaretskii
@ 2020-11-01 21:19 ` Eric Abrahamsen
1 sibling, 0 replies; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-01 21:19 UTC (permalink / raw)
To: Basil L. Contovounesios; +Cc: Lars Ingebrigtsen, 44016
[-- Attachment #1: Type: text/plain, Size: 586 bytes --]
On 11/01/20 18:10 PM, Basil L. Contovounesios wrote:
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> Finally done! I think. Most of the final work was writing the docs.
>
> Thanks! I only had time to look through the manual, and it looks good,
> modulo some minor markup nits.
Some day... some day, I will learn to write texi properly. I see I also
forgot a NEWS entry. Thanks to both of you for your comments.
I'm attaching just the diff for the manual changes. I think I've got all
of your (plural) comments -- the @table hint was particularly helpful,
thank you.
Eric
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: gnus-search-docs.diff --]
[-- Type: text/x-patch, Size: 27467 bytes --]
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 69ac05d5aa..01b26565c7 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -795,19 +795,11 @@ Top
Searching
-* nnir:: Searching with various engines.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: Creating search groups.
+* Search Queries:: Gnus' built-in search syntax.
* nnmairix:: Searching with Mairix.
-nnir
-
-* What is nnir?:: What does nnir do.
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up nnir.
-
-Setting up nnir
-
-* Associating Engines:: How to associate engines.
-
Various
* Process/Prefix:: A convention used by many treatment commands.
@@ -17919,12 +17911,11 @@ Selection Groups
@lisp
(nnselect-specs
- (nnselect-function . nnir-run-query)
+ (nnselect-function . gnus-search-run-query)
(nnselect-args
- (nnir-query-spec
- (query . "FLAGGED")
- (criteria . ""))
- (nnir-group-spec
+ (search-query-spec
+ (query . "mark:flag"))
+ (search-group-spec
("nnimap:home")
("nnimap:work"))))
@end lisp
@@ -17945,9 +17936,8 @@ Selection Groups
(days-to-time (car args)))))
(cons 'criteria "")))
(group-spec (cadr args)))
- (nnir-run-query (cons 'nnir-specs
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))))
+ (gnus-search-run-query (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))))
@end lisp
Then the following @code{nnselect-specs}:
@@ -17970,18 +17960,13 @@ Selection Groups
A refresh can always be invoked manually through
@code{gnus-group-get-new-news-this-group}.
-The nnir interface (@pxref{nnir}) includes engines for searching a
-variety of backends. While the details of each search engine vary,
-the result of an nnir search is always a vector of the sort used by
-the nnselect method, and the results of nnir queries are usually
-viewed using an nnselect group. Indeed the standard search function
-@code{gnus-group-read-ephemeral-search-group} just creates an
-ephemeral nnselect group with the appropriate nnir query as the
-@code{nnselect-specs}. nnir originally included both the search
-engines and the glue to connect search results to gnus. Over time
-this glue evolved into the nnselect method. The two had a mostly
-amicable parting so that nnselect could pursue its dream of becoming a
-fully functioning backend, but occasional conflicts may still linger.
+Gnus includes engines for searching a variety of backends. While the
+details of each search engine vary, the result of a search is always a
+vector of the sort used by the nnselect method, and the results of
+queries are usually viewed using an nnselect group. Indeed the
+standard search function @code{gnus-group-read-ephemeral-search-group}
+just creates an ephemeral nnselect group with the appropriate search
+query as the @code{nnselect-specs}.
@node Combined Groups
@subsection Combined Groups
@@ -21445,9 +21430,6 @@ Searching
@chapter Searching
@cindex searching
-FIXME: A brief comparison of nnir, nnmairix, contrib/gnus-namazu would
-be nice.
-
Gnus has various ways of finding articles that match certain criteria
(from a particular author, on a certain subject, etc.). The simplest
method is to enter a group and then either "limit" the summary buffer
@@ -21455,50 +21437,166 @@ Searching
or searching through messages in the summary buffer (@pxref{Searching
for Articles}).
-Limiting commands and summary buffer searching work on subsets of the
-articles already fetched from the servers, and these commands won't
-query the server for additional articles. While simple, these methods
-are therefore inadequate if the desired articles span multiple groups,
-or if the group is so large that fetching all articles is impractical.
-Many backends (such as imap, notmuch, namazu, etc.) provide their own
-facilities to search for articles directly on the server and Gnus can
-take advantage of these methods. This chapter describes tools for
-searching groups and servers for articles matching a query.
+Limiting commands and summary buffer searching work on articles
+already fetched from the servers, and these commands won't query the
+server for additional articles. While simple, these methods are
+therefore inadequate if the desired articles span multiple groups, or
+if the group is so large that fetching all articles is impractical.
+
+It's possible to search a backend more thoroughly using an associated
+search engine. Some backends come with their own search engine: IMAP
+servers, for instance, do their own searching. Other backends, for
+example a local @code{nnmaildir} installation, might require the user
+to manually set up some sort of search indexing. Default associations
+between backends and engines can be defined in
+@code{gnus-search-default-engines}, and engines can also be defined on
+a per-backend basis (@pxref{Search Engines}).
+
+Once the search engines are set up, you can search for messages in
+groups from one or more backends, and show the results in a group.
+The groups that hold search results are created on the nnselect
+backend, and can be either ephemeral or persistent (@pxref{Creating
+Search Groups}).
+
+@vindex gnus-search-use-parsed-queries
+Search queries can be specified one of two ways: either using the
+syntax of the engine responsible for the group you're searching, or
+using Gnus' generalized search syntax. Set the option
+@code{gnus-search-use-parsed-queries} to a non-nil value to used the
+generalized syntax. The advantage of this syntax is that, if you have
+multiple backends indexed by different engines, you don't need to
+remember which one you're searching---it's also possible to issue the
+same query against multiple groups, indexed by different engines, at
+the same time. It also provides a few other conveniences including
+relative date parsing and tie-ins into other Emacs packages. For
+details on Gnus' query language, see @ref{Search Queries}.
@menu
-* nnir:: Searching with various engines.
-* nnmairix:: Searching with Mairix.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: How and where.
+* Search Queries:: Gnus' built-in search syntax.
+* nnmairix:: Searching with Mairix.
@end menu
-@node nnir
-@section nnir
-@cindex nnir
+@node Search Engines
+@section Search Engines
+@cindex search engines
+@cindex configuring search
+
+In order to search for messages from any given server, that server
+must have a search engine associated with it. IMAP servers do their
+own searching (theoretically it is possible to use a different engine
+to search an IMAP store, but we don't recommend it), but in all other
+cases the user will have to manually specify an engine to use. This
+can be done at two different levels: by server type, or on a
+per-server basis.
+
+@vindex gnus-search-default-engines
+The option @code{gnus-search-default-engines} assigns search engines
+by server type. Its value is an alist mapping symbols indicating a
+server type (e.g.@: @code{nnmaildir} or @code{nnml}) to symbols
+indicating a search engine class. The built-in search engine symbols
+are:
-This section describes how to use @code{nnir} to search for articles
-within gnus.
+@itemize
+@item
+@code{gnus-search-imap}
-@menu
-* What is nnir?:: What does @code{nnir} do?
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up @code{nnir}.
-@end menu
+@item
+@code{gnus-search-find-grep}
-@node What is nnir?
-@subsection What is nnir?
+@item
+@code{gnus-search-notmuch}
-@code{nnir} is a Gnus interface to a number of tools for searching
-through mail and news repositories. Different backends (like
-@code{nnimap} and @code{nntp}) work with different tools (called
-@dfn{engines} in @code{nnir} lingo), but all use the same basic search
-interface.
+@item
+@code{gnus-search-swish-e}
-The @code{nnimap} search engine should work with no configuration.
-Other engines may require a local index that needs to be created and
-maintained outside of Gnus.
+@item
+@code{gnus-search-swish++}
+@item
+@code{gnus-search-mairix}
-@node Basic Usage
-@subsection Basic Usage
+@item
+@code{gnus-search-namazu}
+@end itemize
+
+If you need more granularity, you can specify a search engine in the
+server definition, using the @code{gnus-search-engine} key, whether
+that be in your @file{.gnus.el} config file, or through Gnus' server
+buffer. That might look like:
+
+@example
+'(nnmaildir "My Mail"
+ (directory "/home/user/.mail")
+ (gnus-search-engine gnus-search-notmuch
+ (config-file "/home/user/.mail/.notmuch_config")))
+@end example
+
+Search engines like notmuch, namazu and mairix 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.
+
+These engines have a handful of configuration parameters in common.
+These common parameters are:
+
+@table @code
+@item program
+The name of the executable. Defaults to the plain
+program name such as @command{notmuch} or @command{namazu}.
+
+@item config-file
+The absolute filename of the configuration file for this search
+engine.
+
+@item remove-prefix
+The directory part to be removed from the filenames returned by the
+search query. This absolute path should include everything up to the
+top level of the message store.
+
+@item switches
+Additional command-line switches to be fed to the search program. The
+value of this parameter must be a list of strings, one string per
+switch.
+@end table
+
+The options above can be set in one of two ways: using a customization
+option that is set for all engines of that type, or on a per-engine
+basis in your server configuration files.
+
+The customization options are formed on the pattern
+@code{gnus-search-@var{engine}-@var{parameter}}. For instance, to use a
+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++''.
+
+Alternately, the options can be set directly on your Gnus server
+definitions, for instance, in the @code{nnmaildir} example above.
+Note that the server options are part of the @code{gnus-search-engine}
+sexp, and the option symbol and value form a two-element list, not a
+cons cell.
+
+The namazu and swish-e engines each have one additional option,
+specifying where to store their index files. For namazu it is
+@code{index-directory}, and should be a single directory path. For
+swish-e it is @code{index-files}, and should be a list of strings.
+
+All indexed search engines come with their own method of updating
+their search indexes to include newly-arrived messages. Gnus
+currently provides no convenient interface for this, and you'll have
+to manage updates yourself, though this will likely change in the
+future.
+
+Lastly, all search engines accept a @code{raw-queries-p} option. This
+indicates that engines of this type (or this particular engine) should
+always use raw queries, never parsed (@pxref{Search Queries}).
+
+@node Creating Search Groups
+@section Creating Search Groups
+@cindex creating search groups
In the group buffer typing @kbd{G G} will search the group on the
current line by calling @code{gnus-group-read-ephemeral-search-group}.
@@ -21525,297 +21623,142 @@ Basic Usage
original group for the article on the current line with @kbd{A W}, aka
@code{gnus-warp-to-article}.
-You say you want to search more than just the group on the current line?
-No problem: just process-mark the groups you want to search. You want
-even more? Calling for an nnir search with the cursor on a topic heading
-will search all the groups under that heading.
+You say you want to search more than just the group on the current
+line? No problem: just process-mark the groups you want to search.
+You want even more? Initiating a search with the cursor on a topic
+heading will search all the groups under that topic.
+@vindex gnus-search-ignored-newsgroups
Still not enough? OK, in the server buffer
-@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G})
+@code{gnus-group-read-ephemeral-search-group} (here bound to @kbd{G})
will search all groups from the server on the current line. Too much?
Want to ignore certain groups when searching, like spam groups? Just
-customize @code{nnir-ignored-newsgroups}.
-
-One more thing: individual search engines may have special search
-features. You can access these special features by giving a
-prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you
-are searching multiple groups with different search engines you will
-be prompted for the special search features for each engine
-separately.
-
-
-@node Setting up nnir
-@subsection Setting up nnir
-
-To set up nnir you may need to do some prep work. Firstly, you may
-need to configure the search engines you plan to use. Some of them,
-like @code{imap}, need no special configuration. Others, like
-@code{namazu} and @code{swish}, require configuration as described
-below. Secondly, you need to associate a search engine with a server
-or a backend.
+customize @code{gnus-search-ignored-newsgroups}: groups matching this
+regexp will not be searched.
+
+@node Search Queries
+@section Search Queries
+@cindex search queries
+@cindex search syntax
+
+Gnus provides an optional unified search syntax that can be used
+across all supported search engines. This can be convenient in that
+you don't have to remember different search syntaxes; it's also
+possible to mark multiple groups indexed by different engines and
+issue a single search against them.
+
+@vindex gnus-search-use-parsed-queries
+Set the option @code{gnus-search-use-parsed-queries} to non-@code{nil}
+to enable this---it is @code{nil} by default. Even if it is
+non-@code{nil}, it's still possible to turn off parsing for a class of
+engines or a single engine (@pxref{Search Engines}), or a single
+search by giving a prefix argument to any of the search commands.
+
+The search syntax is fairly simple: keys and values are separated by a
+colon, multi-word values must be quoted, ``and'' is implicit, ``or''
+is explicit, ``not'' will negate the following expression (or keys can
+be prefixed with a ``-''),and parentheses can be used to group logical
+sub-clauses. For example:
-If you just want to use the @code{imap} engine to search @code{nnimap}
-servers then you don't have to do anything. But you might want to
-read the details of the query language anyway.
-
-@menu
-* Associating Engines:: How to associate engines.
-* The imap Engine:: Imap configuration and usage.
-* The swish++ Engine:: Swish++ configuration and usage.
-* The swish-e Engine:: Swish-e configuration and usage.
-* The namazu Engine:: Namazu configuration and usage.
-* The notmuch Engine:: Notmuch configuration and usage.
-* The hyrex Engine:: Hyrex configuration and usage.
-* Customizations:: User customizable settings.
-@end menu
-
-@node Associating Engines
-@subsubsection Associating Engines
-
-
-When searching a group, @code{nnir} needs to know which search engine to
-use. You can configure a given server to use a particular engine by
-setting the server variable @code{nnir-search-engine} to the engine
-name. For example to use the @code{namazu} engine to search the server
-named @code{home} you can use
-
-@lisp
-(setq gnus-secondary-select-methods
- '((nnml "home"
- (nnimap-address "localhost")
- (nnir-search-engine namazu))))
-@end lisp
-
-Alternatively you might want to use a particular engine for all servers
-with a given backend. For example, you might want to use the @code{imap}
-engine for all servers using the @code{nnimap} backend. In this case you
-can customize the variable @code{nnir-method-default-engines}. This is
-an alist of pairs of the form @code{(backend . engine)}. By default this
-variable is set to use the @code{imap} engine for all servers using the
-@code{nnimap} backend. But if you wanted to use @code{namazu} for all
-your servers with an @code{nnimap} backend you could change this to
-
-@lisp
-'((nnimap . namazu))
-@end lisp
-
-@node The imap Engine
-@subsubsection The imap Engine
-
-The @code{imap} engine requires no configuration.
-
-Queries using the @code{imap} engine follow a simple query language.
-The search is always case-insensitive and supports the following
-features (inspired by the Google search input language):
-
-@table @samp
-
-@item Boolean query operators
-AND, OR, and NOT are supported, and parentheses can be used to control
-operator precedence, e.g., (emacs OR xemacs) AND linux. Note that
-operators must be written with all capital letters to be
-recognized. Also preceding a term with a @minus{} sign is equivalent
-to NOT term.
-
-@item Automatic AND queries
-If you specify multiple words then they will be treated as an AND
-expression intended to match all components.
-
-@item Phrase searches
-If you wrap your query in double-quotes then it will be treated as a
-literal string.
-
-@end table
-
-By default the whole message will be searched. The query can be limited
-to a specific part of a message by using a prefix-arg. After inputting
-the query this will prompt (with completion) for a message part.
-Choices include ``Whole message'', ``Subject'', ``From'', and
-``To''. Any unrecognized input is interpreted as a header name. For
-example, typing @kbd{Message-ID} in response to this prompt will limit
-the query to the Message-ID header.
-
-Finally selecting ``Imap'' will interpret the query as a raw
-@acronym{IMAP} search query. The format of such queries can be found in
-RFC3501.
-
-If you don't like the default of searching whole messages you can
-customize @code{nnir-imap-default-search-key}. For example to use
-@acronym{IMAP} queries by default
-
-@lisp
-(setq nnir-imap-default-search-key "Imap")
-@end lisp
-
-@node The swish++ Engine
-@subsubsection The swish++ Engine
-
-FIXME: Say something more here.
-
-Documentation for swish++ may be found at the swish++ sourceforge page:
-@uref{http://swishplusplus.sourceforge.net}
-
-@table @code
-
-@item nnir-swish++-program
-The name of the swish++ executable. Defaults to @code{search}
-
-@item nnir-swish++-additional-switches
-A list of strings to be given as additional arguments to
-swish++. @code{nil} by default.
-
-@item nnir-swish++-remove-prefix
-The prefix to remove from each file name returned by swish++ in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The swish-e Engine
-@subsubsection The swish-e Engine
-
-FIXME: Say something more here.
-
-@table @code
-
-@item nnir-swish-e-program
-The name of the swish-e search program. Defaults to @code{swish-e}.
-
-@item nnir-swish-e-additional-switches
-A list of strings to be given as additional arguments to
-swish-e. @code{nil} by default.
-
-@item nnir-swish-e-remove-prefix
-The prefix to remove from each file name returned by swish-e in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The namazu Engine
-@subsubsection The namazu Engine
-
-Using the namazu engine requires creating and maintaining index files.
-One directory should contain all the index files, and nnir must be told
-where to find them by setting the @code{nnir-namazu-index-directory}
-variable.
-
-To work correctly the @code{nnir-namazu-remove-prefix} variable must
-also be correct. This is the prefix to remove from each file name
-returned by Namazu in order to get a proper group name (albeit with @samp{/}
-instead of @samp{.}).
-
-For example, suppose that Namazu returns file names such as
-@samp{/home/john/Mail/mail/misc/42}. For this example, use the
-following setting: @code{(setq nnir-namazu-remove-prefix
-"/home/john/Mail/")} Note the trailing slash. Removing this prefix from
-the directory gives @samp{mail/misc/42}. @code{nnir} knows to remove
-the @samp{/42} and to replace @samp{/} with @samp{.} to arrive at the
-correct group name @samp{mail.misc}.
-
-Extra switches may be passed to the namazu search command by setting the
-variable @code{nnir-namazu-additional-switches}. It is particularly
-important not to pass any switches to namazu that will change the
-output format. Good switches to use include @option{--sort},
-@option{--ascending}, @option{--early} and @option{--late}.
-Refer to the Namazu documentation for further
-information on valid switches.
-
-Mail must first be indexed with the @command{mknmz} program. Read the
-documentation for namazu to create a configuration file. Here is an
-example:
-
-@cartouche
@example
- package conf; # Don't remove this line!
-
- # Paths which will not be indexed. Don't use '^' or '$' anchors.
- $EXCLUDE_PATH = "spam|sent";
-
- # Header fields which should be searchable. case-insensitive
- $REMAIN_HEADER = "from|date|message-id|subject";
-
- # Searchable fields. case-insensitive
- $SEARCH_FIELD = "from|date|message-id|subject";
-
- # The max length of a word.
- $WORD_LENG_MAX = 128;
-
- # The max length of a field.
- $MAX_FIELD_LENGTH = 256;
-@end example
-@end cartouche
-
-For this example, mail is stored in the directories @samp{~/Mail/mail/},
-@samp{~/Mail/lists/} and @samp{~/Mail/archive/}, so to index them go to
-the index directory set in @code{nnir-namazu-index-directory} and issue
-the following command:
-
-@example
-mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
+(from:john or from:peter) subject:"lunch tomorrow" since:3d
@end example
-For maximum searching efficiency you might want to have a cron job run
-this command periodically, say every four hours.
+The syntax is made to be accepted by a wide range of engines, and thus
+will happily accept most input, valid or not. Some terms will only be
+meaningful to some engines; other engines will drop them silently.
+Key completion is offered on @key{TAB}, but it's also possible to
+enter the query with abbreviated keys, which will be expanded during
+parsing. If a key is abbreviated to the point of ambiguity (for
+instance, ``s:'' could be ``subject:'' or ``since:''), an error will
+be raised.
-@node The notmuch Engine
-@subsubsection The notmuch Engine
-
-@table @code
-@item nnir-notmuch-program
-The name of the notmuch search executable. Defaults to
-@samp{notmuch}.
-
-@item nnir-notmuch-additional-switches
-A list of strings, to be given as additional arguments to notmuch.
-
-@item nnir-notmuch-remove-prefix
-The prefix to remove from each file name returned by notmuch in order
-to get a group name (albeit with @samp{/} instead of @samp{.}). This
-is a regular expression.
-
-@item nnir-notmuch-filter-group-names-function
-A function used to transform the names of groups being searched in,
-for use as a ``path:'' search keyword for notmuch. If nil, the
-default, ``path:'' keywords are not used. Otherwise, this should be a
-callable which accepts a single group name and returns a transformed
-name as notmuch expects to see it. In many mail backends, for
-instance, dots in group names must be converted to forward slashes: to
-achieve this, set this option to
-@example
-(lambda (g) (replace-regexp-in-string "\\." "/" g))
-@end example
+Supported keys include all the usual mail headers: ``from'',
+``subject'', ``cc'', etc. Other keys are:
+@table @samp
+@item body
+The body of the message.
+@item recipient
+Equivalent to @samp{to or cc or bcc}.
+@item address
+Equivalent to @samp{from or recipient}.
+@item id
+The keys @samp{message-id} and @samp{id} are equivalent.
+@item mark
+Accepts @samp{flag}, @samp{seen}, @samp{read} or @samp{replied}, or
+any of Gnus' single-letter representations of those marks, e.g.@:
+@samp{mark:R} for @samp{read}.
+@item tag
+This is interpreted as @samp{keyword} for IMAP and @samp{tag} for
+notmuch.
+@item attachment
+Matches the attachment file name.
+@item before
+Date is exclusive; see below for date parsing.
+@item after
+Date is inclusive; can also use @samp{since}.
+@item thread
+Return entire message threads, not just individual messages.
+@item raw
+Do not parse this particular search.
+@item limit
+Limit the results to this many messages. When searching multiple
+groups this may give undesired results, as the limiting happens before
+sorting.
+@item grep
+Only applicable to ``local index'' engines such as mairix or notmuch.
+On systems with a grep command, additionally filter the results by
+using the value of this term as a grep regexp.
@end table
+@vindex gnus-search-contact-sources
+If an Elisp-based contact management package (e.g.@: BBDB or EBDB)
+pushes a function onto the option @code{gnus-search-contact-sources},
+three other keys become available:
-@node The hyrex Engine
-@subsubsection The hyrex Engine
-This engine is obsolete.
-
-@node Customizations
-@subsubsection Customizations
-
-@table @code
+@table @samp
+@item contact-from
+Search by contact name, and the actual search will use all the
+contact's email addresses.
+@item contact-to
+The same, but as if @samp{recipient}.
+@item contact
+The same, but as if @samp{address}.
+@end table
+
+@subsection Date value parsing
+
+@vindex gnus-search-date-keys
+Date-type keys (see @code{gnus-search-date-keys}) will accept a wide
+variety of values. First, anything that @code{parse-time-string} can
+parse is acceptable. Dates with missing values will be interpreted as
+the most recent occurrence thereof: for instance ``march 03'' is the
+most recent March 3rd. Lastly, it's possible to use relative
+specifications, such as ``3d'' (three days ago). This format also accepts
+w, m and y.
+
+When creating persistent search groups, the search is saved unparsed,
+and re-parsed every time the group is updated. So a permanent search
+group with a query like:
-@item nnir-method-default-engines
-Alist of pairs of server backends and search engines. The default
-association is
@example
-(nnimap . imap)
+from:"my boss" mark:flag since:1w
@end example
-@item nnir-ignored-newsgroups
-A regexp to match newsgroups in the active file that should be skipped
-when searching all groups on a server.
-
-@end table
-
+would always contain only messages from the past seven days.
@node nnmairix
@section nnmairix
@cindex mairix
@cindex nnmairix
+
+This section is now mostly obsolete, as mairix can be used as a regular
+search engine, including persistent search groups, with
+@code{nnselect}.
+
This paragraph describes how to set up mairix and the back end
@code{nnmairix} for indexing and searching your mail from within
Gnus. Additionally, you can create permanent ``smart'' groups which are
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-01 5:32 ` Eric Abrahamsen
2020-11-01 18:10 ` Basil L. Contovounesios
@ 2020-11-01 21:38 ` Eric Abrahamsen
2020-11-01 23:50 ` Stefan Monnier
1 sibling, 1 reply; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-01 21:38 UTC (permalink / raw)
To: 44016; +Cc: Stefan Monnier
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>
>> On 10/16/20 07:08 AM, Lars Ingebrigtsen wrote:
>>> Eric Abrahamsen <eric@ericabrahamsen.net> writes:
>>>
>>>> - This patch doesn't remove the nnir.el library, though that's now
>>>> obsolete. I think removing it could be problematic: it's not like
>>>> declaring functions/variables obsolete, where we can let people down
>>>> gently. I suspect plenty of code uses (require 'nnir), which will
>>>> cause blowups. Renaming gnus-search.el to nnir.el doesn't make a lot
>>>> of sense, though. I'm considering leaving the nnir.el file in there,
>>>> but containing nothing but a warning.
>>>
>>> Just move it to obsolete/.
>>
>> Oh, of course -- thanks.
>
> Finally done! I think. Most of the final work was writing the docs.
Stefan, I am also dragging you into this briefly, because we talked
(perhaps several years ago now) about providing nice completion for the
search keys in this library: both using TAB in the minibuffer while
entering the search query, and also expanding abbreviated keys
programmatically during parsing.
So far as I know I've done this correctly, but I wanted to run it by you
and see if you had any suggestions/corrections.
The expandable search keys are kept in `gnus-search-expandable-keys'.
The programmatic completion part looks like:
--8<---------------cut here---------------start------------->8---
+(defun gnus-search-query-expand-key (key)
+ (cond ((test-completion key gnus-search-expandable-keys)
+ ;; We're done!
+ key)
+ ;; There is more than one possible completion.
+ ((consp (cdr (completion-all-completions
+ key gnus-search-expandable-keys #'stringp 0)))
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key))))
+ ;; Return KEY, either completed or untouched.
+ ((car-safe (completion-try-completion
+ key gnus-search-expandable-keys
+ #'stringp 0)))))
--8<---------------cut here---------------end--------------->8---
The desired behavior is that a key is expanded if it's a prefix of only
one key in `gnus-search-expandable-keys', it's left alone if it isn't,
and an error is raised if it's a prefix of more than one expandable key.
That means the user can't enter their own arbitrary keys that are a
prefix of a known key, but, too bad.
The interactive minibuffer part looks like:
--8<---------------cut here---------------start------------->8---
+(defvar gnus-search-minibuffer-map
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km minibuffer-local-map)
+ (define-key km (kbd "SPC") #'self-insert-command)
+ (define-key km (kbd "TAB") #'gnus-search-complete-key)
+ km))
+
+(defun gnus-search-complete-key ()
+ "Complete a search key at point.
+Used when reading a search query from the minibuffer."
+ (interactive)
+ (when (completion-in-region
+ (save-excursion
+ (if (re-search-backward " " (minibuffer-prompt-end) t)
+ (1+ (point))
+ (minibuffer-prompt-end)))
+ (point) gnus-search-expandable-keys)
+ (insert ":")))
+
+(defun gnus-search-make-spec (arg)
+ (list (cons 'query
+ (read-from-minibuffer
+ "Query: " nil gnus-search-minibuffer-map
+ nil 'gnus-search-history))
+ (cons 'raw arg)))
--8<---------------cut here---------------end--------------->8---
This appears to work, though there's more that I can do in
`gnus-search-complete-key' to check the surrounding text and handle
various situations gracefully. Mostly I'm not entirely confident that
`completion-in-region' is the right function to be using here.
Thanks for any tips,
Eric
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-01 21:38 ` Eric Abrahamsen
@ 2020-11-01 23:50 ` Stefan Monnier
2020-11-02 3:43 ` Eric Abrahamsen
0 siblings, 1 reply; 14+ messages in thread
From: Stefan Monnier @ 2020-11-01 23:50 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 44016
> The expandable search keys are kept in `gnus-search-expandable-keys'.
> The programmatic completion part looks like:
>
> --8<---------------cut here---------------start------------->8---
> +(defun gnus-search-query-expand-key (key)
> + (cond ((test-completion key gnus-search-expandable-keys)
> + ;; We're done!
> + key)
> + ;; There is more than one possible completion.
> + ((consp (cdr (completion-all-completions
> + key gnus-search-expandable-keys #'stringp 0)))
> + (signal 'gnus-search-parse-error
> + (list (format "Ambiguous keyword: %s" key))))
> + ;; Return KEY, either completed or untouched.
> + ((car-safe (completion-try-completion
> + key gnus-search-expandable-keys
> + #'stringp 0)))))
> --8<---------------cut here---------------end--------------->8---
IIUC this function is used to expand unambiguous abbreviations, right
(rather than the more usual "completion" which is done as the user is
typing)?
It just happens to reuse the completion machinery to do the work.
If so, it looks OK (I guess you could try and reuse the output from
completion-all-completions in the last branch instead of calling
completion-try-completion, but it might be more trouble than it's worth).
> --8<---------------cut here---------------start------------->8---
> +(defvar gnus-search-minibuffer-map
> + (let ((km (make-sparse-keymap)))
> + (set-keymap-parent km minibuffer-local-map)
> + (define-key km (kbd "SPC") #'self-insert-command)
> + (define-key km (kbd "TAB") #'gnus-search-complete-key)
> + km))
> +
> +(defun gnus-search-complete-key ()
> + "Complete a search key at point.
> +Used when reading a search query from the minibuffer."
> + (interactive)
> + (when (completion-in-region
> + (save-excursion
> + (if (re-search-backward " " (minibuffer-prompt-end) t)
> + (1+ (point))
> + (minibuffer-prompt-end)))
> + (point) gnus-search-expandable-keys)
> + (insert ":")))
> +
> +(defun gnus-search-make-spec (arg)
> + (list (cons 'query
> + (read-from-minibuffer
> + "Query: " nil gnus-search-minibuffer-map
> + nil 'gnus-search-history))
> + (cons 'raw arg)))
> --8<---------------cut here---------------end--------------->8---
Hmm... here I think instead of calling `completion-in-region` yourself,
you'd want to do something like:
(defvar gnus-search-minibuffer-map
(let ((km (make-sparse-keymap)))
(set-keymap-parent km minibuffer-local-map)
(define-key km (kbd "SPC") #'self-insert-command) ;; Isn't this redundant?
(define-key km (kbd "TAB") #'completion-at-point)
km))
(defun gnus-search--complete-key-data ()
"Return completion data for gnus-search keys."
(list (save-excursion
(if (re-search-backward " " (minibuffer-prompt-end) t)
(1+ (point))
(minibuffer-prompt-end)))
(point)
gnus-search-expandable-keys))
(minibuffer-with-setup-hook
(lambda ()
(add-hook 'completion-at-point-functions
#'gnus-search--complete-key-data nil t))
(read-from-minibuffer ...))
See `read--expression` (used to provide completion on Elisp function
and var names when reading an ELisp expression in the minibuffer, such
as in `M-:`) for an example.
If you want to auto-insert a `:` you'd then do it via an `:exit-function`.
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-01 23:50 ` Stefan Monnier
@ 2020-11-02 3:43 ` Eric Abrahamsen
2020-11-02 14:24 ` Stefan Monnier
0 siblings, 1 reply; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-02 3:43 UTC (permalink / raw)
To: Stefan Monnier; +Cc: 44016
On 11/01/20 18:50 PM, Stefan Monnier wrote:
>> The expandable search keys are kept in `gnus-search-expandable-keys'.
>> The programmatic completion part looks like:
>>
>> --8<---------------cut here---------------start------------->8---
>> +(defun gnus-search-query-expand-key (key)
>> + (cond ((test-completion key gnus-search-expandable-keys)
>> + ;; We're done!
>> + key)
>> + ;; There is more than one possible completion.
>> + ((consp (cdr (completion-all-completions
>> + key gnus-search-expandable-keys #'stringp 0)))
>> + (signal 'gnus-search-parse-error
>> + (list (format "Ambiguous keyword: %s" key))))
>> + ;; Return KEY, either completed or untouched.
>> + ((car-safe (completion-try-completion
>> + key gnus-search-expandable-keys
>> + #'stringp 0)))))
>> --8<---------------cut here---------------end--------------->8---
>
> IIUC this function is used to expand unambiguous abbreviations, right
> (rather than the more usual "completion" which is done as the user is
> typing)?
Right, at this stage the string is already out of the user's hands.
> It just happens to reuse the completion machinery to do the work.
I wrote a function to do the expansion, then realized it was just a poor
implementation of half of what the completion functions already do. I
understand that these functions are aimed at interactive use (the
"(consp (cdr (completion-all-completions" bit above definitely felt like
I was holding the tool upside down), but they're absolutely useful in a
programmatic setting. I wonder if there could be some version of these
functions that could be "blessed" for use in Elisp programs.
> If so, it looks OK (I guess you could try and reuse the output from
> completion-all-completions in the last branch instead of calling
> completion-try-completion, but it might be more trouble than it's worth).
>
>> --8<---------------cut here---------------start------------->8---
>> +(defvar gnus-search-minibuffer-map
>> + (let ((km (make-sparse-keymap)))
>> + (set-keymap-parent km minibuffer-local-map)
>> + (define-key km (kbd "SPC") #'self-insert-command)
>> + (define-key km (kbd "TAB") #'gnus-search-complete-key)
>> + km))
>> +
>> +(defun gnus-search-complete-key ()
>> + "Complete a search key at point.
>> +Used when reading a search query from the minibuffer."
>> + (interactive)
>> + (when (completion-in-region
>> + (save-excursion
>> + (if (re-search-backward " " (minibuffer-prompt-end) t)
>> + (1+ (point))
>> + (minibuffer-prompt-end)))
>> + (point) gnus-search-expandable-keys)
>> + (insert ":")))
>> +
>> +(defun gnus-search-make-spec (arg)
>> + (list (cons 'query
>> + (read-from-minibuffer
>> + "Query: " nil gnus-search-minibuffer-map
>> + nil 'gnus-search-history))
>> + (cons 'raw arg)))
>> --8<---------------cut here---------------end--------------->8---
>
> Hmm... here I think instead of calling `completion-in-region` yourself,
> you'd want to do something like:
>
> (defvar gnus-search-minibuffer-map
> (let ((km (make-sparse-keymap)))
> (set-keymap-parent km minibuffer-local-map)
> (define-key km (kbd "SPC") #'self-insert-command) ;; Isn't this redundant?
Somewhere I'd gotten the idea that SPC was bound to
`minibuffer-complete-word', I don't know how.
> (define-key km (kbd "TAB") #'completion-at-point)
> km))
>
> (defun gnus-search--complete-key-data ()
> "Return completion data for gnus-search keys."
> (list (save-excursion
> (if (re-search-backward " " (minibuffer-prompt-end) t)
> (1+ (point))
> (minibuffer-prompt-end)))
> (point)
> gnus-search-expandable-keys))
>
> (minibuffer-with-setup-hook
> (lambda ()
> (add-hook 'completion-at-point-functions
> #'gnus-search--complete-key-data nil t))
> (read-from-minibuffer ...))
>
> See `read--expression` (used to provide completion on Elisp function
> and var names when reading an ELisp expression in the minibuffer, such
> as in `M-:`) for an example.
>
> If you want to auto-insert a `:` you'd then do it via an `:exit-function`.
Ah, of course! And if `gnus-search--complete-key-data' is conservative
about when it fires, it leaves the door open for other completion
functions. This function could complete "cont" to "contact:", at which
point (for example) an EBDB-specific capf function could take over and
complete names or email addresses to search for.
Thanks!
Eric
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-02 3:43 ` Eric Abrahamsen
@ 2020-11-02 14:24 ` Stefan Monnier
2020-11-02 16:16 ` Eric Abrahamsen
0 siblings, 1 reply; 14+ messages in thread
From: Stefan Monnier @ 2020-11-02 14:24 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 44016
> (the "(consp (cdr (completion-all-completions" bit above definitely
> felt like I was holding the tool upside down),
It's just another way (more efficient) way to write
(< 1 (length (completion-all-completions ...)))
so it looks fine from where I stand.
> but they're absolutely useful in a programmatic setting. I wonder if
> there could be some version of these functions that could be "blessed"
> for use in Elisp programs.
They're definitely allowed to be used for ELisp programs. They're not
100% pure functions, but not too far off. The main issue I can see for
use "internal use" is that their behavior is influenced by the
`completion-styles` user-config, which may or may not be what you want.
>> (defvar gnus-search-minibuffer-map
>> (let ((km (make-sparse-keymap)))
>> (set-keymap-parent km minibuffer-local-map)
>> (define-key km (kbd "SPC") #'self-insert-command) ;; Isn't this redundant?
>
> Somewhere I'd gotten the idea that SPC was bound to
> `minibuffer-complete-word', I don't know how.
I presume you earlier inherited from `minibuffer-local-completion-map`
or something like that.
> Ah, of course! And if `gnus-search--complete-key-data' is conservative
> about when it fires, it leaves the door open for other completion
> functions.
If by "fires" you mean "returns non-nil", then yes, indeed.
> This function could complete "cont" to "contact:", at which
> point (for example) an EBDB-specific capf function could take over and
> complete names or email addresses to search for.
Right. Or it could itself recognize "contact:" and return the bounds of
the contact info along with EBDB's completion table (since EBDB's
capf presumably doesn't know about the "contact:" syntax).
Stefan
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-02 14:24 ` Stefan Monnier
@ 2020-11-02 16:16 ` Eric Abrahamsen
2020-11-02 20:11 ` Eric Abrahamsen
0 siblings, 1 reply; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-02 16:16 UTC (permalink / raw)
To: Stefan Monnier; +Cc: 44016
Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> (the "(consp (cdr (completion-all-completions" bit above definitely
>> felt like I was holding the tool upside down),
>
> It's just another way (more efficient) way to write
>
> (< 1 (length (completion-all-completions ...)))
>
> so it looks fine from where I stand.
The return value for multiple matches is not a proper list (looks like
("subject" "since" . 0)), so I couldn't use `length' on it. That and the
fact that the strings have a face property made it seem like the
function wasn't really meant for what I was doing with it
>> but they're absolutely useful in a programmatic setting. I wonder if
>> there could be some version of these functions that could be "blessed"
>> for use in Elisp programs.
>
> They're definitely allowed to be used for ELisp programs. They're not
> 100% pure functions, but not too far off. The main issue I can see for
> use "internal use" is that their behavior is influenced by the
> `completion-styles` user-config, which may or may not be what you want.
I'll wait and see if that's a problem. If I'm expecting a completion
style that completes hyphenated strings ("con-f" -> "contact-from") and
the user has removed that style it could be an issue. I wonder how many
users even know about this configuration, though.
>>> (defvar gnus-search-minibuffer-map
>>> (let ((km (make-sparse-keymap)))
>>> (set-keymap-parent km minibuffer-local-map)
>>> (define-key km (kbd "SPC") #'self-insert-command) ;; Isn't this redundant?
>>
>> Somewhere I'd gotten the idea that SPC was bound to
>> `minibuffer-complete-word', I don't know how.
>
> I presume you earlier inherited from `minibuffer-local-completion-map`
> or something like that.
Yes, I was confusing with `completing-read'.
>> Ah, of course! And if `gnus-search--complete-key-data' is conservative
>> about when it fires, it leaves the door open for other completion
>> functions.
>
> If by "fires" you mean "returns non-nil", then yes, indeed.
>
>> This function could complete "cont" to "contact:", at which
>> point (for example) an EBDB-specific capf function could take over and
>> complete names or email addresses to search for.
>
> Right. Or it could itself recognize "contact:" and return the bounds of
> the contact info along with EBDB's completion table (since EBDB's
> capf presumably doesn't know about the "contact:" syntax).
Right, it would be much easier just to have a variable where
contact-management packages can register a completion table. Now I'm
thinking there's no real need for a "contact" key at all, just offer
completion on to/from/recipient/etc. Anyway, I've already got the code
working, thanks again for the pointers.
Eric
^ permalink raw reply [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-02 16:16 ` Eric Abrahamsen
@ 2020-11-02 20:11 ` Eric Abrahamsen
2020-11-04 5:22 ` Eric Abrahamsen
0 siblings, 1 reply; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-02 20:11 UTC (permalink / raw)
To: 44016
[-- Attachment #1: Type: text/plain, Size: 93 bytes --]
Okay, I think this is Close Enough. I'm going to sit on it for a couple
of days, then push.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-New-gnus-search-library.patch --]
[-- Type: text/x-patch, Size: 123790 bytes --]
From 62bf65495bcea9d7d279a1a1f9cd1b2a1ee990ca Mon Sep 17 00:00:00 2001
From: Eric Abrahamsen <eric@ericabrahamsen.net>
Date: Wed, 14 Oct 2020 21:39:46 -0700
Subject: [PATCH 1/3] New gnus-search library
This library provides a fundamental reworking of the search
functionality previously found in nnir.el. It uses class-based search
engines to interface with external searching facilities, and a parsed
search query syntax that can search multiple engines.
* lisp/gnus/gnus-search.el: New library containing search
functionality for Gnus.
* doc/misc/gnus.texi: Document.
* lisp/gnus/gnus-group.el (gnus-group-make-search-group,
gnus-group-read-ephemeral-search-group): Remove references to nnir,
change meaning of prefix argument, change values of nnselect-function
and nnselect-args.
* lisp/gnus/nnselect.el: Replace references to nnir
(nnselect-request-article): Use gnus-search functions, and search
criteria.
(nnselect-request-thread, nnselect-search-thread): Use gnus-search
thread search.
(gnus-summary-make-search-group): Switch to use gnus-search function
and arguments.
* test/lisp/gnus/search-tests.el: Tests for new functionality.
---
doc/misc/gnus.texi | 598 ++++---
etc/NEWS | 8 +-
lisp/gnus/gnus-group.el | 68 +-
lisp/gnus/gnus-search.el | 2227 +++++++++++++++++++++++++++
lisp/gnus/nnselect.el | 91 +-
test/lisp/gnus/gnus-search-tests.el | 96 ++
6 files changed, 2674 insertions(+), 414 deletions(-)
create mode 100644 lisp/gnus/gnus-search.el
create mode 100644 test/lisp/gnus/gnus-search-tests.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 69ac05d5aa..340fc69dbb 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -795,19 +795,11 @@ Top
Searching
-* nnir:: Searching with various engines.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: Creating search groups.
+* Search Queries:: Gnus' built-in search syntax.
* nnmairix:: Searching with Mairix.
-nnir
-
-* What is nnir?:: What does nnir do.
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up nnir.
-
-Setting up nnir
-
-* Associating Engines:: How to associate engines.
-
Various
* Process/Prefix:: A convention used by many treatment commands.
@@ -17919,12 +17911,11 @@ Selection Groups
@lisp
(nnselect-specs
- (nnselect-function . nnir-run-query)
+ (nnselect-function . gnus-search-run-query)
(nnselect-args
- (nnir-query-spec
- (query . "FLAGGED")
- (criteria . ""))
- (nnir-group-spec
+ (search-query-spec
+ (query . "mark:flag"))
+ (search-group-spec
("nnimap:home")
("nnimap:work"))))
@end lisp
@@ -17945,9 +17936,8 @@ Selection Groups
(days-to-time (car args)))))
(cons 'criteria "")))
(group-spec (cadr args)))
- (nnir-run-query (cons 'nnir-specs
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))))
+ (gnus-search-run-query (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))))
@end lisp
Then the following @code{nnselect-specs}:
@@ -17970,18 +17960,13 @@ Selection Groups
A refresh can always be invoked manually through
@code{gnus-group-get-new-news-this-group}.
-The nnir interface (@pxref{nnir}) includes engines for searching a
-variety of backends. While the details of each search engine vary,
-the result of an nnir search is always a vector of the sort used by
-the nnselect method, and the results of nnir queries are usually
-viewed using an nnselect group. Indeed the standard search function
-@code{gnus-group-read-ephemeral-search-group} just creates an
-ephemeral nnselect group with the appropriate nnir query as the
-@code{nnselect-specs}. nnir originally included both the search
-engines and the glue to connect search results to gnus. Over time
-this glue evolved into the nnselect method. The two had a mostly
-amicable parting so that nnselect could pursue its dream of becoming a
-fully functioning backend, but occasional conflicts may still linger.
+Gnus includes engines for searching a variety of backends. While the
+details of each search engine vary, the result of a search is always a
+vector of the sort used by the nnselect method, and the results of
+queries are usually viewed using an nnselect group. Indeed the
+standard search function @code{gnus-group-read-ephemeral-search-group}
+just creates an ephemeral nnselect group with the appropriate search
+query as the @code{nnselect-specs}.
@node Combined Groups
@subsection Combined Groups
@@ -21445,9 +21430,6 @@ Searching
@chapter Searching
@cindex searching
-FIXME: A brief comparison of nnir, nnmairix, contrib/gnus-namazu would
-be nice.
-
Gnus has various ways of finding articles that match certain criteria
(from a particular author, on a certain subject, etc.). The simplest
method is to enter a group and then either "limit" the summary buffer
@@ -21455,50 +21437,166 @@ Searching
or searching through messages in the summary buffer (@pxref{Searching
for Articles}).
-Limiting commands and summary buffer searching work on subsets of the
-articles already fetched from the servers, and these commands won't
-query the server for additional articles. While simple, these methods
-are therefore inadequate if the desired articles span multiple groups,
-or if the group is so large that fetching all articles is impractical.
-Many backends (such as imap, notmuch, namazu, etc.) provide their own
-facilities to search for articles directly on the server and Gnus can
-take advantage of these methods. This chapter describes tools for
-searching groups and servers for articles matching a query.
+Limiting commands and summary buffer searching work on articles
+already fetched from the servers, and these commands won't query the
+server for additional articles. While simple, these methods are
+therefore inadequate if the desired articles span multiple groups, or
+if the group is so large that fetching all articles is impractical.
+
+It's possible to search a backend more thoroughly using an associated
+search engine. Some backends come with their own search engine: IMAP
+servers, for instance, do their own searching. Other backends, for
+example a local @code{nnmaildir} installation, might require the user
+to manually set up some sort of search indexing. Default associations
+between backends and engines can be defined in
+@code{gnus-search-default-engines}, and engines can also be defined on
+a per-backend basis (@pxref{Search Engines}).
+
+Once the search engines are set up, you can search for messages in
+groups from one or more backends, and show the results in a group.
+The groups that hold search results are created on the nnselect
+backend, and can be either ephemeral or persistent (@pxref{Creating
+Search Groups}).
+
+@vindex gnus-search-use-parsed-queries
+Search queries can be specified one of two ways: either using the
+syntax of the engine responsible for the group you're searching, or
+using Gnus' generalized search syntax. Set the option
+@code{gnus-search-use-parsed-queries} to a non-nil value to used the
+generalized syntax. The advantage of this syntax is that, if you have
+multiple backends indexed by different engines, you don't need to
+remember which one you're searching---it's also possible to issue the
+same query against multiple groups, indexed by different engines, at
+the same time. It also provides a few other conveniences including
+relative date parsing and tie-ins into other Emacs packages. For
+details on Gnus' query language, see @ref{Search Queries}.
@menu
-* nnir:: Searching with various engines.
-* nnmairix:: Searching with Mairix.
+* Search Engines:: Selecting and configuring search engines.
+* Creating Search Groups:: How and where.
+* Search Queries:: Gnus' built-in search syntax.
+* nnmairix:: Searching with Mairix.
@end menu
-@node nnir
-@section nnir
-@cindex nnir
+@node Search Engines
+@section Search Engines
+@cindex search engines
+@cindex configuring search
+
+In order to search for messages from any given server, that server
+must have a search engine associated with it. IMAP servers do their
+own searching (theoretically it is possible to use a different engine
+to search an IMAP store, but we don't recommend it), but in all other
+cases the user will have to manually specify an engine to use. This
+can be done at two different levels: by server type, or on a
+per-server basis.
+
+@vindex gnus-search-default-engines
+The option @code{gnus-search-default-engines} assigns search engines
+by server type. Its value is an alist mapping symbols indicating a
+server type (e.g.@: @code{nnmaildir} or @code{nnml}) to symbols
+indicating a search engine class. The built-in search engine symbols
+are:
+
+@itemize
+@item
+@code{gnus-search-imap}
-This section describes how to use @code{nnir} to search for articles
-within gnus.
+@item
+@code{gnus-search-find-grep}
-@menu
-* What is nnir?:: What does @code{nnir} do?
-* Basic Usage:: How to perform simple searches.
-* Setting up nnir:: How to set up @code{nnir}.
-@end menu
+@item
+@code{gnus-search-notmuch}
-@node What is nnir?
-@subsection What is nnir?
+@item
+@code{gnus-search-swish-e}
-@code{nnir} is a Gnus interface to a number of tools for searching
-through mail and news repositories. Different backends (like
-@code{nnimap} and @code{nntp}) work with different tools (called
-@dfn{engines} in @code{nnir} lingo), but all use the same basic search
-interface.
+@item
+@code{gnus-search-swish++}
+
+@item
+@code{gnus-search-mairix}
+
+@item
+@code{gnus-search-namazu}
+@end itemize
+
+If you need more granularity, you can specify a search engine in the
+server definition, using the @code{gnus-search-engine} key, whether
+that be in your @file{.gnus.el} config file, or through Gnus' server
+buffer. That might look like:
-The @code{nnimap} search engine should work with no configuration.
-Other engines may require a local index that needs to be created and
-maintained outside of Gnus.
+@example
+'(nnmaildir "My Mail"
+ (directory "/home/user/.mail")
+ (gnus-search-engine gnus-search-notmuch
+ (config-file "/home/user/.mail/.notmuch_config")))
+@end example
+Search engines like notmuch, namazu and mairix 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.
-@node Basic Usage
-@subsection Basic Usage
+These engines have a handful of configuration parameters in common.
+These common parameters are:
+
+@table @code
+@item program
+The name of the executable. Defaults to the plain
+program name such as @command{notmuch} or @command{namazu}.
+
+@item config-file
+The absolute filename of the configuration file for this search
+engine.
+
+@item remove-prefix
+The directory part to be removed from the filenames returned by the
+search query. This absolute path should include everything up to the
+top level of the message store.
+
+@item switches
+Additional command-line switches to be fed to the search program. The
+value of this parameter must be a list of strings, one string per
+switch.
+@end table
+
+The options above can be set in one of two ways: using a customization
+option that is set for all engines of that type, or on a per-engine
+basis in your server configuration files.
+
+The customization options are formed on the pattern
+@code{gnus-search-@var{engine}-@var{parameter}}. For instance, to use a
+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++''.
+
+Alternately, the options can be set directly on your Gnus server
+definitions, for instance, in the @code{nnmaildir} example above.
+Note that the server options are part of the @code{gnus-search-engine}
+sexp, and the option symbol and value form a two-element list, not a
+cons cell.
+
+The namazu and swish-e engines each have one additional option,
+specifying where to store their index files. For namazu it is
+@code{index-directory}, and should be a single directory path. For
+swish-e it is @code{index-files}, and should be a list of strings.
+
+All indexed search engines come with their own method of updating
+their search indexes to include newly-arrived messages. Gnus
+currently provides no convenient interface for this, and you'll have
+to manage updates yourself, though this will likely change in the
+future.
+
+Lastly, all search engines accept a @code{raw-queries-p} option. This
+indicates that engines of this type (or this particular engine) should
+always use raw queries, never parsed (@pxref{Search Queries}).
+
+@node Creating Search Groups
+@section Creating Search Groups
+@cindex creating search groups
In the group buffer typing @kbd{G G} will search the group on the
current line by calling @code{gnus-group-read-ephemeral-search-group}.
@@ -21525,297 +21623,133 @@ Basic Usage
original group for the article on the current line with @kbd{A W}, aka
@code{gnus-warp-to-article}.
-You say you want to search more than just the group on the current line?
-No problem: just process-mark the groups you want to search. You want
-even more? Calling for an nnir search with the cursor on a topic heading
-will search all the groups under that heading.
+You say you want to search more than just the group on the current
+line? No problem: just process-mark the groups you want to search.
+You want even more? Initiating a search with the cursor on a topic
+heading will search all the groups under that topic.
+@vindex gnus-search-ignored-newsgroups
Still not enough? OK, in the server buffer
-@code{gnus-group-read-ephemeral-search-group} (now bound to @kbd{G})
+@code{gnus-group-read-ephemeral-search-group} (here bound to @kbd{G})
will search all groups from the server on the current line. Too much?
Want to ignore certain groups when searching, like spam groups? Just
-customize @code{nnir-ignored-newsgroups}.
-
-One more thing: individual search engines may have special search
-features. You can access these special features by giving a
-prefix-arg to @code{gnus-group-read-ephemeral-search-group}. If you
-are searching multiple groups with different search engines you will
-be prompted for the special search features for each engine
-separately.
-
-
-@node Setting up nnir
-@subsection Setting up nnir
-
-To set up nnir you may need to do some prep work. Firstly, you may
-need to configure the search engines you plan to use. Some of them,
-like @code{imap}, need no special configuration. Others, like
-@code{namazu} and @code{swish}, require configuration as described
-below. Secondly, you need to associate a search engine with a server
-or a backend.
-
-If you just want to use the @code{imap} engine to search @code{nnimap}
-servers then you don't have to do anything. But you might want to
-read the details of the query language anyway.
-
-@menu
-* Associating Engines:: How to associate engines.
-* The imap Engine:: Imap configuration and usage.
-* The swish++ Engine:: Swish++ configuration and usage.
-* The swish-e Engine:: Swish-e configuration and usage.
-* The namazu Engine:: Namazu configuration and usage.
-* The notmuch Engine:: Notmuch configuration and usage.
-* The hyrex Engine:: Hyrex configuration and usage.
-* Customizations:: User customizable settings.
-@end menu
-
-@node Associating Engines
-@subsubsection Associating Engines
-
-
-When searching a group, @code{nnir} needs to know which search engine to
-use. You can configure a given server to use a particular engine by
-setting the server variable @code{nnir-search-engine} to the engine
-name. For example to use the @code{namazu} engine to search the server
-named @code{home} you can use
-
-@lisp
-(setq gnus-secondary-select-methods
- '((nnml "home"
- (nnimap-address "localhost")
- (nnir-search-engine namazu))))
-@end lisp
-
-Alternatively you might want to use a particular engine for all servers
-with a given backend. For example, you might want to use the @code{imap}
-engine for all servers using the @code{nnimap} backend. In this case you
-can customize the variable @code{nnir-method-default-engines}. This is
-an alist of pairs of the form @code{(backend . engine)}. By default this
-variable is set to use the @code{imap} engine for all servers using the
-@code{nnimap} backend. But if you wanted to use @code{namazu} for all
-your servers with an @code{nnimap} backend you could change this to
-
-@lisp
-'((nnimap . namazu))
-@end lisp
-
-@node The imap Engine
-@subsubsection The imap Engine
-
-The @code{imap} engine requires no configuration.
-
-Queries using the @code{imap} engine follow a simple query language.
-The search is always case-insensitive and supports the following
-features (inspired by the Google search input language):
-
-@table @samp
-
-@item Boolean query operators
-AND, OR, and NOT are supported, and parentheses can be used to control
-operator precedence, e.g., (emacs OR xemacs) AND linux. Note that
-operators must be written with all capital letters to be
-recognized. Also preceding a term with a @minus{} sign is equivalent
-to NOT term.
-
-@item Automatic AND queries
-If you specify multiple words then they will be treated as an AND
-expression intended to match all components.
-
-@item Phrase searches
-If you wrap your query in double-quotes then it will be treated as a
-literal string.
-
-@end table
-
-By default the whole message will be searched. The query can be limited
-to a specific part of a message by using a prefix-arg. After inputting
-the query this will prompt (with completion) for a message part.
-Choices include ``Whole message'', ``Subject'', ``From'', and
-``To''. Any unrecognized input is interpreted as a header name. For
-example, typing @kbd{Message-ID} in response to this prompt will limit
-the query to the Message-ID header.
-
-Finally selecting ``Imap'' will interpret the query as a raw
-@acronym{IMAP} search query. The format of such queries can be found in
-RFC3501.
-
-If you don't like the default of searching whole messages you can
-customize @code{nnir-imap-default-search-key}. For example to use
-@acronym{IMAP} queries by default
-
-@lisp
-(setq nnir-imap-default-search-key "Imap")
-@end lisp
-
-@node The swish++ Engine
-@subsubsection The swish++ Engine
-
-FIXME: Say something more here.
-
-Documentation for swish++ may be found at the swish++ sourceforge page:
-@uref{http://swishplusplus.sourceforge.net}
-
-@table @code
-
-@item nnir-swish++-program
-The name of the swish++ executable. Defaults to @code{search}
-
-@item nnir-swish++-additional-switches
-A list of strings to be given as additional arguments to
-swish++. @code{nil} by default.
-
-@item nnir-swish++-remove-prefix
-The prefix to remove from each file name returned by swish++ in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The swish-e Engine
-@subsubsection The swish-e Engine
-
-FIXME: Say something more here.
-
-@table @code
-
-@item nnir-swish-e-program
-The name of the swish-e search program. Defaults to @code{swish-e}.
-
-@item nnir-swish-e-additional-switches
-A list of strings to be given as additional arguments to
-swish-e. @code{nil} by default.
-
-@item nnir-swish-e-remove-prefix
-The prefix to remove from each file name returned by swish-e in order
-to get a group name. By default this is @code{$HOME/Mail}.
-
-@end table
-
-@node The namazu Engine
-@subsubsection The namazu Engine
-
-Using the namazu engine requires creating and maintaining index files.
-One directory should contain all the index files, and nnir must be told
-where to find them by setting the @code{nnir-namazu-index-directory}
-variable.
-
-To work correctly the @code{nnir-namazu-remove-prefix} variable must
-also be correct. This is the prefix to remove from each file name
-returned by Namazu in order to get a proper group name (albeit with @samp{/}
-instead of @samp{.}).
-
-For example, suppose that Namazu returns file names such as
-@samp{/home/john/Mail/mail/misc/42}. For this example, use the
-following setting: @code{(setq nnir-namazu-remove-prefix
-"/home/john/Mail/")} Note the trailing slash. Removing this prefix from
-the directory gives @samp{mail/misc/42}. @code{nnir} knows to remove
-the @samp{/42} and to replace @samp{/} with @samp{.} to arrive at the
-correct group name @samp{mail.misc}.
-
-Extra switches may be passed to the namazu search command by setting the
-variable @code{nnir-namazu-additional-switches}. It is particularly
-important not to pass any switches to namazu that will change the
-output format. Good switches to use include @option{--sort},
-@option{--ascending}, @option{--early} and @option{--late}.
-Refer to the Namazu documentation for further
-information on valid switches.
-
-Mail must first be indexed with the @command{mknmz} program. Read the
-documentation for namazu to create a configuration file. Here is an
-example:
-
-@cartouche
-@example
- package conf; # Don't remove this line!
-
- # Paths which will not be indexed. Don't use '^' or '$' anchors.
- $EXCLUDE_PATH = "spam|sent";
-
- # Header fields which should be searchable. case-insensitive
- $REMAIN_HEADER = "from|date|message-id|subject";
-
- # Searchable fields. case-insensitive
- $SEARCH_FIELD = "from|date|message-id|subject";
-
- # The max length of a word.
- $WORD_LENG_MAX = 128;
-
- # The max length of a field.
- $MAX_FIELD_LENGTH = 256;
-@end example
-@end cartouche
-
-For this example, mail is stored in the directories @samp{~/Mail/mail/},
-@samp{~/Mail/lists/} and @samp{~/Mail/archive/}, so to index them go to
-the index directory set in @code{nnir-namazu-index-directory} and issue
-the following command:
+customize @code{gnus-search-ignored-newsgroups}: groups matching this
+regexp will not be searched.
+
+@node Search Queries
+@section Search Queries
+@cindex search queries
+@cindex search syntax
+
+Gnus provides an optional unified search syntax that can be used
+across all supported search engines. This can be convenient in that
+you don't have to remember different search syntaxes; it's also
+possible to mark multiple groups indexed by different engines and
+issue a single search against them.
+
+@vindex gnus-search-use-parsed-queries
+Set the option @code{gnus-search-use-parsed-queries} to non-@code{nil}
+to enable this---it is @code{nil} by default. Even if it is
+non-@code{nil}, it's still possible to turn off parsing for a class of
+engines or a single engine (@pxref{Search Engines}), or a single
+search by giving a prefix argument to any of the search commands.
+
+The search syntax is fairly simple: keys and values are separated by a
+colon, multi-word values must be quoted, ``and'' is implicit, ``or''
+is explicit, ``not'' will negate the following expression (or keys can
+be prefixed with a ``-''),and parentheses can be used to group logical
+sub-clauses. For example:
@example
-mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
+(from:john or from:peter) subject:"lunch tomorrow" since:3d
@end example
-For maximum searching efficiency you might want to have a cron job run
-this command periodically, say every four hours.
+The syntax is made to be accepted by a wide range of engines, and thus
+will happily accept most input, valid or not. Some terms will only be
+meaningful to some engines; other engines will drop them silently.
+Key completion is offered on @key{TAB}, but it's also possible to
+enter the query with abbreviated keys, which will be expanded during
+parsing. If a key is abbreviated to the point of ambiguity (for
+instance, ``s:'' could be ``subject:'' or ``since:''), an error will
+be raised.
-@node The notmuch Engine
-@subsubsection The notmuch Engine
-
-@table @code
-@item nnir-notmuch-program
-The name of the notmuch search executable. Defaults to
-@samp{notmuch}.
-
-@item nnir-notmuch-additional-switches
-A list of strings, to be given as additional arguments to notmuch.
-
-@item nnir-notmuch-remove-prefix
-The prefix to remove from each file name returned by notmuch in order
-to get a group name (albeit with @samp{/} instead of @samp{.}). This
-is a regular expression.
-
-@item nnir-notmuch-filter-group-names-function
-A function used to transform the names of groups being searched in,
-for use as a ``path:'' search keyword for notmuch. If nil, the
-default, ``path:'' keywords are not used. Otherwise, this should be a
-callable which accepts a single group name and returns a transformed
-name as notmuch expects to see it. In many mail backends, for
-instance, dots in group names must be converted to forward slashes: to
-achieve this, set this option to
-@example
-(lambda (g) (replace-regexp-in-string "\\." "/" g))
-@end example
+Supported keys include all the usual mail headers: ``from'',
+``subject'', ``cc'', etc. Other keys are:
+@table @samp
+@item body
+The body of the message.
+@item recipient
+Equivalent to @samp{to or cc or bcc}.
+@item address
+Equivalent to @samp{from or recipient}.
+@item id
+The keys @samp{message-id} and @samp{id} are equivalent.
+@item mark
+Accepts @samp{flag}, @samp{seen}, @samp{read} or @samp{replied}, or
+any of Gnus' single-letter representations of those marks, e.g.@:
+@samp{mark:R} for @samp{read}.
+@item tag
+This is interpreted as @samp{keyword} for IMAP and @samp{tag} for
+notmuch.
+@item attachment
+Matches the attachment file name.
+@item before
+Date is exclusive; see below for date parsing.
+@item after
+Date is inclusive; can also use @samp{since}.
+@item thread
+Return entire message threads, not just individual messages.
+@item raw
+Do not parse this particular search.
+@item limit
+Limit the results to this many messages. When searching multiple
+groups this may give undesired results, as the limiting happens before
+sorting.
+@item grep
+Only applicable to ``local index'' engines such as mairix or notmuch.
+On systems with a grep command, additionally filter the results by
+using the value of this term as a grep regexp.
@end table
+@vindex gnus-search-contact-tables
+Elisp-based contact management packages (e.g.@: BBDB or EBDB) can push
+completion tables onto the variable @code{gnus-search-contact-tables},
+allowing auto-completion of contact names and addresses for keys like
+@samp{from} or @samp{to}.
-@node The hyrex Engine
-@subsubsection The hyrex Engine
-This engine is obsolete.
+@subsection Date value parsing
-@node Customizations
-@subsubsection Customizations
+@vindex gnus-search-date-keys
+Date-type keys (see @code{gnus-search-date-keys}) will accept a wide
+variety of values. First, anything that @code{parse-time-string} can
+parse is acceptable. Dates with missing values will be interpreted as
+the most recent occurrence thereof: for instance ``march 03'' is the
+most recent March 3rd. Lastly, it's possible to use relative
+specifications, such as ``3d'' (three days ago). This format also accepts
+w, m and y.
-@table @code
+When creating persistent search groups, the search is saved unparsed,
+and re-parsed every time the group is updated. So a permanent search
+group with a query like:
-@item nnir-method-default-engines
-Alist of pairs of server backends and search engines. The default
-association is
@example
-(nnimap . imap)
+from:"my boss" mark:flag since:1w
@end example
-@item nnir-ignored-newsgroups
-A regexp to match newsgroups in the active file that should be skipped
-when searching all groups on a server.
-
-@end table
-
+would always contain only messages from the past seven days.
@node nnmairix
@section nnmairix
@cindex mairix
@cindex nnmairix
+
+This section is now mostly obsolete, as mairix can be used as a regular
+search engine, including persistent search groups, with
+@code{nnselect}.
+
This paragraph describes how to set up mairix and the back end
@code{nnmairix} for indexing and searching your mail from within
Gnus. Additionally, you can create permanent ``smart'' groups which are
diff --git a/etc/NEWS b/etc/NEWS
index e11effc9e8..6468f69e66 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -452,7 +452,13 @@ tags to be considered as well.
** Gnus
+++
-*** New value for user option 'smiley-style'.
+*** New gnus-search library
+A new unified search syntax which can be used across multiple
+supported search engines. Set 'gnus-search-use-parsed-queries' to
+non-nil to enable.
+
++++
+*** New value for user option 'smiley-style'
Smileys can now be rendered with emojis instead of small images when
using the new 'emoji' value in 'smiley-style'.
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 1d614f8a8d..c6f7e1c41a 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -3165,29 +3165,27 @@ gnus-group-make-directory-group
(gnus-group-real-name group)
(list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-
-(autoload 'nnir-read-parms "nnir")
-(autoload 'nnir-server-to-search-engine "nnir")
(autoload 'gnus-group-topic-name "gnus-topic")
+(autoload 'gnus-search-make-spec "gnus-search")
;; Temporary to make group creation easier
-(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-make-search-group (no-parse &optional specs)
"Make a group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let ((name (gnus-read-group "Group name: ")))
(with-current-buffer gnus-group-buffer
(let* ((group-spec
(or
- (cdr (assq 'nnir-group-spec specs))
+ (cdr (assq 'search-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3199,16 +3197,8 @@ gnus-group-make-search-group
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
(query-spec
(or
- (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (cdr (assq 'search-query-spec specs))
+ (gnus-search-make-spec no-parse))))
(gnus-group-make-group
name
(list 'nnselect "nnselect")
@@ -3216,29 +3206,29 @@ gnus-group-make-search-group
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))))
(define-obsolete-function-alias 'gnus-group-make-nnir-group
'gnus-group-read-ephemeral-search-group "28.1")
-(defun gnus-group-read-ephemeral-search-group (nnir-extra-parms &optional specs)
+(defun gnus-group-read-ephemeral-search-group (no-parse &optional specs)
"Read an nnselect group based on a search.
Prompt for a search query and determine the groups to search as
follows: if called from the *Server* buffer search all groups
belonging to the server on the current line; if called from the
*Group* buffer search any marked groups, or the group on the
-current line, or all the groups under the current topic. Calling
-with a prefix arg prompts for additional search-engine specific
-constraints. A non-nil SPECS arg must be an alist with
-`nnir-query-spec' and `nnir-group-spec' keys, and skips all
-prompting."
+current line, or all the groups under the current topic. A
+prefix arg NO-PARSE means that Gnus should not parse the search
+query before passing it to the underlying search engine. A
+non-nil SPECS arg must be an alist with `search-query-spec' and
+`search-group-spec' keys, and skips all prompting."
(interactive "P")
(let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
+ (or (cdr (assq 'search-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(seq-group-by
@@ -3249,16 +3239,8 @@ gnus-group-read-ephemeral-search-group
(cdr
(assoc (gnus-group-topic-name) gnus-topic-alist))))))))
(query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
+ (or (cdr (assq 'search-query-spec specs))
+ (gnus-search-make-spec no-parse))))
(gnus-group-read-ephemeral-group
(concat "nnselect-" (message-unique-id))
(list 'nnselect "nnselect")
@@ -3268,10 +3250,10 @@ gnus-group-read-ephemeral-search-group
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec)))))
(cons 'nnselect-artlist nil)))))
(defun gnus-group-add-to-virtual (n vgroup)
diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el
new file mode 100644
index 0000000000..2c217d73ae
--- /dev/null
+++ b/lisp/gnus/gnus-search.el
@@ -0,0 +1,2227 @@
+;;; gnus-search.el --- Search facilities for Gnus -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2020 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file defines a generalized search language, and search engines
+;; that interface with various search programs. It is responsible for
+;; parsing the user's search input, sending that query to the search
+;; engines, and collecting results. Results are in the form of a
+;; vector of vectors, each vector representing a found article. The
+;; nnselect backend interprets that value to create a group containing
+;; the search results.
+
+;; This file was formerly known as nnir. Later, the backend parts of
+;; nnir became nnselect, and only the search functionality was left
+;; here.
+
+;; See the Gnus manual for details of the search language. Tests are
+;; in tests/gnus-search-test.el.
+
+;; The search parsing routines are responsible for accepting the
+;; user's search query as a string and parsing it into a sexp
+;; structure. The function `gnus-search-parse-query' is the entry
+;; point for that. Once the query is in sexp form, it is passed to
+;; the search engines themselves, which are responsible for
+;; transforming the query into a form that the external program can
+;; understand, and then filtering the search results into a format
+;; that nnselect can understand.
+
+;; The general flow is:
+
+;; 1. The user calls one of `gnus-group-make-search-group' or
+;; `gnus-group-make-permanent-search-group' (or a few other entry
+;; points). These functions prompt for a search query, and collect
+;; the groups to search, then create an nnselect group, setting an
+;; 'nnselect-specs group parameter where 'nnselect-function is
+;; `gnus-search-run-query', and 'nnselect-args is the search query and
+;; groups to search.
+
+;; 2. `gnus-search-run-query' is called with 'nnselect-args. It looks
+;; at the groups to search, categorizes them by server, and for each
+;; server finds the search engine to use. It calls each engine's
+;; `gnus-search-run-search' method with the query and groups passed as
+;; arguments, and the results are collected and handed off to the
+;; nnselect group.
+
+;; For information on writing new search engines, see the Gnus manual.
+
+;; TODO: Rewrite the query parser using syntax tables and
+;; `parse-partial-sexp'.
+
+;; TODO: Refactor IMAP search so we can move code that uses nnimap-*
+;; functions out into nnimap.el.
+
+;; TODO: Is there anything we can do about sorting results?
+
+;; TODO: Provide for returning a result count. This would probably
+;; need a completely separate top-level command, since we wouldn't be
+;; creating a group at all.
+
+;;; Code:
+
+(require 'gnus-group)
+(require 'gnus-sum)
+(require 'message)
+(require 'gnus-util)
+(require 'eieio)
+(eval-when-compile (require 'cl-lib))
+(autoload 'eieio-build-class-alist "eieio-opt")
+(autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-english-month-names)
+
+;;; Internal Variables:
+
+(defvar gnus-search-memo-query nil
+ "Internal: stores current query.")
+
+(defvar gnus-search-memo-server nil
+ "Internal: stores current server.")
+
+(defvar gnus-search-history ()
+ "Internal history of Gnus searches.")
+
+(define-error 'gnus-search-parse-error "Gnus search parsing error")
+
+;;; User Customizable Variables:
+
+(defgroup gnus-search nil
+ "Search groups in Gnus with assorted search engines."
+ :group 'gnus)
+
+(defcustom gnus-search-use-parsed-queries nil
+ "When t, use Gnus' generalized search language.
+The generalized search language is a search language that can be
+used across all search engines that Gnus supports. See the Gnus
+manual for details.
+
+If this option is set to nil, search queries will be passed
+directly to the search engines without being parsed or
+transformed."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(define-obsolete-variable-alias 'nnir-ignored-newsgroups
+ 'gnus-search-ignored-newsgroups "28.1")
+
+(defcustom gnus-search-ignored-newsgroups ""
+ "A regexp to match newsgroups in the active file that should
+ be skipped when searching."
+ :version "24.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+;; Engine-specific configuration options.
+
+(defcustom gnus-search-swish++-config-file
+ (expand-file-name "~/Mail/swish++.conf")
+ "Location of Swish++ configuration file.
+This variable can also be set per-server."
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-program "search"
+ "Name of swish++ search executable.
+This variable can also be set per-server."
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-switches '()
+ "A list of strings, to be given as additional arguments to swish++.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish++-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish++-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish++
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish++-raw-queries-p nil
+ "If t, all Swish++ engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-config-file
+ (expand-file-name "~/Mail/swish-e.conf")
+ "Configuration file for swish-e.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-program "search"
+ "Name of swish-e search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-switches '()
+ "A list of strings, to be given as additional arguments to swish-e.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-swish-e-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-swish-e-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by swish-e
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-index-files '()
+ "A list of index files to use with this Swish-e instance.
+This variable can also be set per-server."
+ :type '(repeat file)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-swish-e-raw-queries-p nil
+ "If t, all Swish-e engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+;; Namazu engine, see <URL:http://www.namazu.org/>
+
+(defcustom gnus-search-namazu-program "namazu"
+ "Name of Namazu search executable.
+This variable can also be set per-server."
+ :type 'string
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-index-directory (expand-file-name "~/Mail/namazu/")
+ "Index directory for Namazu.
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-switches '()
+ "A list of strings, to be given as additional arguments to namazu.
+The switches `-q', `-a', and `-s' are always used, very few other switches
+make any sense in this context.
+
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-namazu-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-namazu-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by Namazu
+in order to get a group name (albeit with / instead of .).
+
+For example, suppose that Namazu returns file names such as
+\"/home/john/Mail/mail/misc/42\". For this example, use the following
+setting: (setq gnus-search-namazu-remove-prefix \"/home/john/Mail/\")
+Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
+Gnus knows to remove the \"/42\" and to replace \"/\" with \".\" to
+arrive at the correct group name, \"mail.misc\".
+
+This variable can also be set per-server."
+ :type 'directory
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-namazu-raw-queries-p nil
+ "If t, all Namazu engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-program "notmuch"
+ "Name of notmuch search executable.
+This variable can also be set per-server."
+ :type '(string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-config-file
+ (expand-file-name "~/.notmuch-config")
+ "Configuration file for notmuch.
+This variable can also be set per-server."
+ :type 'file
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-switches '()
+ "A list of strings, to be given as additional arguments to notmuch.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-notmuch-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnus-search-notmuch-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :type '(repeat string)
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by notmuch
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :type 'regexp
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-notmuch-raw-queries-p nil
+ "If t, all Notmuch engines will only accept raw search query
+ strings."
+ :type 'boolean
+ :version "28.1"
+ :group 'gnus-search)
+
+(defcustom gnus-search-imap-raw-queries-p nil
+ "If t, all IMAP engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-program "mairix"
+ "Name of mairix search executable.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'string
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-config-file
+ (expand-file-name "~/.mairixrc")
+ "Configuration file for mairix.
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'file
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-switches '()
+ "A list of strings, to be given as additional arguments to mairix.
+Note that this should be a list. I.e., do NOT use the following:
+ (setq gnus-search-mairix-switches \"-i -w\") ; wrong
+Instead, use this:
+ (setq gnu-search-mairix-switches \\='(\"-i\" \"-w\"))
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type '(repeat string)
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-remove-prefix (concat (getenv "HOME") "/Mail/")
+ "The prefix to remove from each file name returned by mairix
+in order to get a group name (albeit with / instead of .). This is a
+regular expression.
+
+This variable can also be set per-server."
+ :version "28.1"
+ :type 'regexp
+ :group 'gnus-search)
+
+(defcustom gnus-search-mairix-raw-queries-p nil
+ "If t, all Mairix engines will only accept raw search query
+ strings."
+ :version "28.1"
+ :type 'boolean
+ :group 'gnus-search)
+
+;; Options for search language parsing.
+
+(defcustom gnus-search-expandable-keys
+ '("from" "subject" "to" "cc" "bcc" "body" "recipient" "date"
+ "mark" "before" "after" "larger" "smaller" "attachment" "text"
+ "since" "thread" "sender" "address" "tag" "size" "grep" "limit"
+ "raw" "message-id" "id")
+ "A list of strings representing expandable search keys.
+\"Expandable\" simply means the key can be abbreviated while
+typing in search queries, ie \"subject\" could be entered as
+\"subj\" or even \"su\", though \"s\" is ambigous between
+\"subject\" and \"since\".
+
+Ambiguous abbreviations will raise an error."
+ :group 'gnus-search
+ :version "28.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-date-keys
+ '("date" "before" "after" "on" "senton" "sentbefore" "sentsince" "since")
+ "A list of keywords whose value should be parsed as a date.
+See the docstring of `gnus-search-parse-query' for information on
+date parsing."
+ :group 'gnus-search
+ :version "26.1"
+ :type '(repeat string))
+
+(defcustom gnus-search-contact-tables '()
+ "A list of completion tables used to search for messages from contacts.
+Each list element should be a table or collection suitable to be
+returned by `completion-at-point-functions'. That usually means
+a list of strings, a hash table, or an alist."
+ :group 'gnus-search
+ :version "28.1"
+ :type 'list)
+
+;;; Search language
+
+;; This "language" was generalized from the original IMAP search query
+;; parsing routine.
+
+(defun gnus-search-parse-query (string)
+ "Turn STRING into an s-expression based query.
+The resulting query structure is passed to the various search
+backends, each of which adapts it as needed.
+
+The search \"language\" is essentially a series of key:value
+expressions. Key is most often a mail header, but there are
+other keys. Value is a string, quoted if it contains spaces.
+Key and value are separated by a colon, no space. Expressions
+are implictly ANDed; the \"or\" keyword can be used to
+OR. \"not\" will negate the following expression, or keys can be
+prefixed with a \"-\". The \"near\" operator will work for
+engines that understand it; other engines will convert it to
+\"or\". Parenthetical groups work as expected.
+
+A key that matches the name of a mail header will search that
+header.
+
+Search keys can be expanded with TAB during entry, or left
+abbreviated so long as they remain unambiguous, ie \"f\" will
+search the \"from\" header. \"s\" will raise an error.
+
+Other keys:
+
+\"address\" will search all sender and recipient headers.
+
+\"recipient\" will search \"To\", \"Cc\", and \"Bcc\".
+
+\"before\" will search messages sent before the specified
+date (date specifications to come later). Date is exclusive.
+
+\"after\" (or its synonym \"since\") will search messages sent
+after the specified date. Date is inclusive.
+
+\"mark\" will search messages that have some sort of mark.
+Likely values include \"flag\", \"seen\", \"read\", \"replied\".
+It's also possible to use Gnus' internal marks, ie \"mark:R\"
+will be interpreted as mark:read.
+
+\"tag\" will search tags -- right now that's translated to
+\"keyword\" in IMAP, and left as \"tag\" for notmuch. At some
+point this should also be used to search marks in the Gnus
+registry.
+
+Other keys can be specified, provided that the search backends
+know how to interpret them.
+
+External contact-management packages can push completion tables
+onto the list variable `gnus-search-contact-tables', to provide
+auto-completion of contact names and addresses for keys like
+\"from\" and \"to\".
+
+Date values (any key in `gnus-search-date-keys') can be provided
+in any format that `parse-time-string' can parse (note that this
+can produce weird results). Dates with missing bits will be
+interpreted as the most recent occurance thereof (ie \"march 03\"
+is the most recent March 3rd). Lastly, relative specifications
+such as 1d (one day ago) are understood. This also accepts w, m,
+and y. m is assumed to be 30 days.
+
+This function will accept pretty much anything as input. Its
+only job is to parse the query into a sexp, and pass that on --
+it is the job of the search backends to make sense of the
+structured query. Malformed, unusable or invalid queries will
+typically be silently ignored."
+ (with-temp-buffer
+ ;; Set up the parsing environment.
+ (insert string)
+ (goto-char (point-min))
+ ;; Now, collect the output terms and return them.
+ (let (out)
+ (while (not (gnus-search-query-end-of-input))
+ (push (gnus-search-query-next-expr) out))
+ (reverse out))))
+
+(defun gnus-search-query-next-expr (&optional count halt)
+ "Return the next expression from the current buffer."
+ (let ((term (gnus-search-query-next-term count))
+ (next (gnus-search-query-peek-symbol)))
+ ;; Deal with top-level expressions. And, or, not, near... What
+ ;; else? Notmuch also provides xor and adj. It also provides a
+ ;; "nearness" parameter for near and adj.
+ (cond
+ ;; Handle 'expr or expr'
+ ((and (eq next 'or)
+ (null halt))
+ (list 'or term (gnus-search-query-next-expr 2)))
+ ;; Handle 'near operator.
+ ((eq next 'near)
+ (let ((near-next (gnus-search-query-next-expr 2)))
+ (if (and (stringp term)
+ (stringp near-next))
+ (list 'near term near-next)
+ (signal 'gnus-search-parse-error
+ (list "\"Near\" keyword must appear between two plain strings.")))))
+ ;; Anything else
+ (t term))))
+
+(defun gnus-search-query-next-term (&optional count)
+ "Return the next TERM from the current buffer."
+ (let ((term (gnus-search-query-next-symbol count)))
+ ;; What sort of term is this?
+ (cond
+ ;; negated term
+ ((eq term 'not) (list 'not (gnus-search-query-next-expr nil 'halt)))
+ ;; generic term
+ (t term))))
+
+(defun gnus-search-query-peek-symbol ()
+ "Return the next symbol from the current buffer, but don't consume it."
+ (save-excursion
+ (gnus-search-query-next-symbol)))
+
+(defun gnus-search-query-next-symbol (&optional count)
+ "Return the next symbol from the current buffer, or nil if we are
+at the end of the buffer. If supplied COUNT skips some symbols before
+returning the one at the supplied position."
+ (when (and (numberp count) (> count 1))
+ (gnus-search-query-next-symbol (1- count)))
+ (let ((case-fold-search t))
+ ;; end of input stream?
+ (unless (gnus-search-query-end-of-input)
+ ;; No, return the next symbol from the stream.
+ (cond
+ ;; Negated expression -- return it and advance one char.
+ ((looking-at "-") (forward-char 1) 'not)
+ ;; List expression -- we parse the content and return this as a list.
+ ((looking-at "(")
+ (gnus-search-parse-query (gnus-search-query-return-string ")" t)))
+ ;; Keyword input -- return a symbol version.
+ ((looking-at "\\band\\b") (forward-char 3) 'and)
+ ((looking-at "\\bor\\b") (forward-char 2) 'or)
+ ((looking-at "\\bnot\\b") (forward-char 3) 'not)
+ ((looking-at "\\bnear\\b") (forward-char 4) 'near)
+ ;; Plain string, no keyword
+ ((looking-at "[\"/]?\\b[^:]+\\([[:blank:]]\\|\\'\\)")
+ (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t)))
+ ;; Assume a K:V expression.
+ (t (let ((key (gnus-search-query-expand-key
+ (buffer-substring
+ (point)
+ (progn
+ (re-search-forward ":" (point-at-eol) t)
+ (1- (point))))))
+ (value (gnus-search-query-return-string
+ (when (looking-at-p "[\"/]") t))))
+ (gnus-search-query-parse-kv key value)))))))
+
+(defun gnus-search-query-parse-kv (key value)
+ "Handle KEY and VALUE, parsing and expanding as necessary.
+This may result in (key value) being turned into a larger query
+structure.
+
+In the simplest case, they are simply consed together. String
+KEY is converted to a symbol."
+ (let (return)
+ (cond
+ ((member key gnus-search-date-keys)
+ (when (string= "after" key)
+ (setq key "since"))
+ (setq value (gnus-search-query-parse-date value)))
+ ((equal key "mark")
+ (setq value (gnus-search-query-parse-mark value)))
+ ((string= "message-id" key)
+ (setq key "id")))
+ (or return
+ (cons (intern key) value))))
+
+(defun gnus-search-query-parse-date (value &optional rel-date)
+ "Interpret VALUE as a date specification.
+See the docstring of `gnus-search-parse-query' for details.
+
+The result is a list of (dd mm yyyy); individual elements can be
+nil.
+
+If VALUE is a relative time, interpret it as relative to
+REL-DATE, or (current-time) if REL-DATE is nil."
+ ;; Time parsing doesn't seem to work with slashes.
+ (let ((value (replace-regexp-in-string "/" "-" value))
+ (now (append '(0 0 0)
+ (seq-subseq (decode-time (or rel-date
+ (current-time)))
+ 3))))
+ ;; Check for relative time parsing.
+ (if (string-match "\\([[:digit:]]+\\)\\([dwmy]\\)" value)
+ (seq-subseq
+ (decode-time
+ (time-subtract
+ (apply #'encode-time now)
+ (days-to-time
+ (* (string-to-number (match-string 1 value))
+ (cdr (assoc (match-string 2 value)
+ '(("d" . 1)
+ ("w" . 7)
+ ("m" . 30)
+ ("y" . 365))))))))
+ 3 6)
+ ;; Otherwise check the value of `parse-time-string'.
+
+ ;; (SEC MIN HOUR DAY MON YEAR DOW DST TZ)
+ (let ((d-time (parse-time-string value)))
+ ;; Did parsing produce anything at all?
+ (if (seq-some #'integerp (seq-subseq d-time 3 7))
+ (seq-subseq
+ ;; If DOW is given, handle that specially.
+ (if (and (seq-elt d-time 6) (null (seq-elt d-time 3)))
+ (decode-time
+ (time-subtract (apply #'encode-time now)
+ (days-to-time
+ (+ (if (> (seq-elt d-time 6)
+ (seq-elt now 6))
+ 7 0)
+ (- (seq-elt now 6) (seq-elt d-time 6))))))
+ d-time)
+ 3 6)
+ ;; `parse-time-string' failed to produce anything, just
+ ;; return the string.
+ value)))))
+
+(defun gnus-search-query-parse-mark (mark)
+ "Possibly transform MARK.
+If MARK is a single character, assume it is one of the
+gnus-*-mark marks, and return an appropriate string."
+ (if (= 1 (length mark))
+ (let ((m (aref mark 0)))
+ ;; Neither pcase nor cl-case will work here.
+ (cond
+ ((eql m gnus-ticked-mark) "flag")
+ ((eql m gnus-read-mark) "read")
+ ((eql m gnus-replied-mark) "replied")
+ ((eql m gnus-recent-mark) "recent")
+ (t mark)))
+ mark))
+
+(defun gnus-search-query-expand-key (key)
+ (cond ((test-completion key gnus-search-expandable-keys)
+ ;; We're done!
+ key)
+ ;; There is more than one possible completion.
+ ((consp (cdr (completion-all-completions
+ key gnus-search-expandable-keys #'stringp 0)))
+ (signal 'gnus-search-parse-error
+ (list (format "Ambiguous keyword: %s" key))))
+ ;; Return KEY, either completed or untouched.
+ ((car-safe (completion-try-completion
+ key gnus-search-expandable-keys
+ #'stringp 0)))))
+
+(defun gnus-search-query-return-string (&optional delimited trim)
+ "Return a string from the current buffer.
+If DELIMITED is non-nil, assume the next character is a delimiter
+character, and return everything between point and the next
+occurance of the delimiter, including the delimiters themselves.
+If TRIM is non-nil, do not return the delimiters. Otherwise,
+return one word."
+ ;; This function cannot handle nested delimiters, as it's not a
+ ;; proper parser. Ie, you cannot parse "to:bob or (from:bob or
+ ;; (cc:bob or bcc:bob))".
+ (let ((start (point))
+ (delimiter (if (stringp delimited)
+ delimited
+ (when delimited
+ (char-to-string (char-after)))))
+ end)
+ (if delimiter
+ (progn
+ (when trim
+ ;; Skip past first delimiter if we're trimming.
+ (forward-char 1))
+ (while (not end)
+ (unless (search-forward delimiter nil t (unless trim 2))
+ (signal 'gnus-search-parse-error
+ (list (format "Unmatched delimited input with %s in query" delimiter))))
+ (let ((here (point)))
+ (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
+ (setq end (if trim (1- (point)) (point))
+ start (if trim (1+ start) start))))))
+ (setq end (progn (re-search-forward "\\([[:blank:]]+\\|$\\)" (point-max) t)
+ (match-beginning 0))))
+ (buffer-substring-no-properties start end)))
+
+(defun gnus-search-query-end-of-input ()
+ "Are we at the end of input?"
+ (skip-chars-forward "[[:blank:]]")
+ (looking-at "$"))
+
+;;; Search engines
+
+;; Search engines are implemented as classes. This is good for two
+;; things: encapsulating things like indexes and search prefixes, and
+;; transforming search queries.
+
+(defclass gnus-search-engine ()
+ ((raw-queries-p
+ :initarg :raw-queries-p
+ :initform nil
+ :type boolean
+ :custom boolean
+ :documentation
+ "When t, searches through this engine will never be parsed or
+ transformed, and must be entered \"raw\"."))
+ :abstract t
+ :documentation "Abstract base class for Gnus search engines.")
+
+(defclass gnus-search-grep ()
+ ((grep-program
+ :initarg :grep-program
+ :initform "grep"
+ :type string
+ :documentation "Grep executable to use for second-pass grep
+ searches.")
+ (grep-options
+ :initarg :grep-options
+ :initform nil
+ :type list
+ :documentation "Additional options, in the form of a list,
+ passed to the second-pass grep search, when present."))
+ :abstract t
+ :documentation "An abstract mixin class that can be added to
+ local-filesystem search engines, providing an additional grep:
+ search key. After the base engine returns a list of search
+ results (as local filenames), an external grep process is used
+ to further filter the results.")
+
+(cl-defgeneric gnus-search-grep-search (engine artlist criteria)
+ "Run a secondary grep search over a list of preliminary results.
+
+ARTLIST is a list of (filename score) pairs, produced by one of
+the other search engines. CRITERIA is a grep-specific search
+key. This method uses an external grep program to further filter
+the files in ARTLIST by that search key.")
+
+(cl-defmethod gnus-search-grep-search ((engine gnus-search-grep)
+ artlist criteria)
+ (with-slots (grep-program grep-options) engine
+ (if (executable-find grep-program)
+ ;; Don't catch errors -- allow them to propagate.
+ (let ((matched-files
+ (apply
+ #'process-lines
+ grep-program
+ `("-l" ,@grep-options
+ "-e" ,(shell-quote-argument criteria)
+ ,@(mapcar #'car artlist)))))
+ (seq-filter (lambda (a) (member (car a) matched-files))
+ artlist))
+ (nnheader-report 'search "invalid grep program: %s" grep-program))))
+
+(defclass gnus-search-process ()
+ ((proc-buffer
+ :initarg :proc-buffer
+ :type buffer
+ :documentation "A temporary buffer this engine uses for its
+ search process, and for munging its search results."))
+ :abstract t
+ :documentation
+ "A mixin class for engines that do their searching in a single
+ process launched for this purpose, which returns at the end of
+ the search. Subclass instances are safe to be run in
+ threads.")
+
+(cl-defmethod shared-initialize ((engine gnus-search-process)
+ slots)
+ (setq slots (plist-put slots :proc-buffer
+ (get-buffer-create
+ (generate-new-buffer-name " *gnus-search-"))))
+ (cl-call-next-method engine slots))
+
+(defclass gnus-search-imap (gnus-search-engine)
+ ((literal-plus
+ :initarg :literal-plus
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle literal+ searches? This slot
+ is set automatically by the imap server, and cannot be
+ set manually. Only the LITERAL+ capability is handled.")
+ (multisearch
+ :initarg :multisearch
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the MULTISEARCH capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently unimplemented.")
+ (fuzzy
+ :initarg :fuzzy
+ :initform nil
+ :type boolean
+ :documentation
+ "Can this search engine handle the FUZZY search capability?
+ This slot is set automatically by the imap server, and cannot
+ be set manually. Currently only partially implemented."))
+ :documentation
+ "The base IMAP search engine, using an IMAP server's search capabilites.
+
+This backend may be subclassed to handle particular IMAP servers'
+quirks.")
+
+(eieio-oset-default 'gnus-search-imap 'raw-queries-p
+ gnus-search-imap-raw-queries-p)
+
+(defclass gnus-search-find-grep (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ nil)
+
+(defclass gnus-search-gmane (gnus-search-engine gnus-search-process)
+ nil)
+
+;;; The "indexed" search engine. These are engines that use an
+;;; external program, with indexes kept on disk, to search messages
+;;; usually kept in some local directory. The three common slots are
+;;; "program", holding the string name of the executable; "switches",
+;;; holding additional switches to pass to the executable; and
+;;; "prefix", which is sort of the path to the found messages which
+;;; should be removed so that Gnus can find them. Many of the
+;;; subclasses also allow distinguishing multiple databases or
+;;; indexes. These slots can be set using a global default, or on a
+;;; per-server basis.
+
+(defclass gnus-search-indexed (gnus-search-engine
+ gnus-search-process
+ gnus-search-grep)
+ ((program
+ :initarg :program
+ :type string
+ :documentation
+ "The executable used for indexing and searching.")
+ (config-file
+ :init-arg :config-file
+ :type string
+ :custom file
+ :documentation "Location of the config file, if any.")
+ (remove-prefix
+ :initarg :remove-prefix
+ :type string
+ :documentation
+ "The path to the directory where the indexed mails are
+ kept. This path is removed from the search results.")
+ (switches
+ :initarg :switches
+ :type list
+ :documentation
+ "Additional switches passed to the search engine command-line
+ program."))
+ :abstract t
+ :allow-nil-initform t
+ :documentation "A base search engine class that assumes a local search index
+ accessed by a command line program.")
+
+(eieio-oset-default 'gnus-search-indexed 'remove-prefix
+ (concat (getenv "HOME") "/Mail/"))
+
+(defclass gnus-search-swish-e (gnus-search-indexed)
+ ((index-files
+ :init-arg :index-files
+ :type list)))
+
+(eieio-oset-default 'gnus-search-swish-e 'program
+ gnus-search-swish-e-program)
+
+(eieio-oset-default 'gnus-search-swish-e 'remove-prefix
+ gnus-search-swish-e-remove-prefix)
+
+(eieio-oset-default 'gnus-search-swish-e 'index-files
+ gnus-search-swish-e-index-files)
+
+(eieio-oset-default 'gnus-search-swish-e 'switches
+ gnus-search-swish-e-switches)
+
+(eieio-oset-default 'gnus-search-swish-e 'raw-queries-p
+ gnus-search-swish-e-raw-queries-p)
+
+(defclass gnus-search-swish++ (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-swish++ 'program
+ gnus-search-swish++-program)
+
+(eieio-oset-default 'gnus-search-swish++ 'remove-prefix
+ gnus-search-swish++-remove-prefix)
+
+(eieio-oset-default 'gnus-search-swish++ 'config-file
+ gnus-search-swish++-config-file)
+
+(eieio-oset-default 'gnus-search-swish++ 'switches
+ gnus-search-swish++-switches)
+
+(eieio-oset-default 'gnus-search-swish++ 'raw-queries-p
+ gnus-search-swish++-raw-queries-p)
+
+(defclass gnus-search-mairix (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-mairix 'program
+ gnus-search-mairix-program)
+
+(eieio-oset-default 'gnus-search-mairix 'switches
+ gnus-search-mairix-switches)
+
+(eieio-oset-default 'gnus-search-mairix 'remove-prefix
+ gnus-search-mairix-remove-prefix)
+
+(eieio-oset-default 'gnus-search-mairix 'config-file
+ gnus-search-mairix-config-file)
+
+(eieio-oset-default 'gnus-search-mairix 'raw-queries-p
+ gnus-search-mairix-raw-queries-p)
+
+(defclass gnus-search-namazu (gnus-search-indexed)
+ ((index-directory
+ :initarg :index-directory
+ :type string
+ :custom directory)))
+
+(eieio-oset-default 'gnus-search-namazu 'program
+ gnus-search-namazu-program)
+
+(eieio-oset-default 'gnus-search-namazu 'index-directory
+ gnus-search-namazu-index-directory)
+
+(eieio-oset-default 'gnus-search-namazu 'switches
+ gnus-search-namazu-switches)
+
+(eieio-oset-default 'gnus-search-namazu 'remove-prefix
+ gnus-search-namazu-remove-prefix)
+
+(eieio-oset-default 'gnus-search-namazu 'raw-queries-p
+ gnus-search-namazu-raw-queries-p)
+
+(defclass gnus-search-notmuch (gnus-search-indexed)
+ nil)
+
+(eieio-oset-default 'gnus-search-notmuch 'program
+ gnus-search-notmuch-program)
+
+(eieio-oset-default 'gnus-search-notmuch 'switches
+ gnus-search-notmuch-switches)
+
+(eieio-oset-default 'gnus-search-notmuch 'remove-prefix
+ gnus-search-notmuch-remove-prefix)
+
+(eieio-oset-default 'gnus-search-notmuch 'config-file
+ gnus-search-notmuch-config-file)
+
+(eieio-oset-default 'gnus-search-notmuch 'raw-queries-p
+ gnus-search-notmuch-raw-queries-p)
+
+(define-obsolete-variable-alias 'nnir-method-default-engines
+ 'gnus-search-default-engines "28.1")
+
+(defcustom gnus-search-default-engines '((nnimap gnus-search-imap)
+ (nntp gnus-search-gmane))
+ "Alist of default search engines keyed by server method."
+ :version "26.1"
+ :group 'gnus-search
+ :type `(repeat (list (choice (const nnimap) (const nntp) (const nnspool)
+ (const nneething) (const nndir) (const nnmbox)
+ (const nnml) (const nnmh) (const nndraft)
+ (const nnfolder) (const nnmaildir))
+ (choice
+ ,@(mapcar
+ (lambda (el) (list 'const (intern (car el))))
+ (eieio-build-class-alist 'gnus-search-engine t))))))
+
+;;; Transforming and running search queries.
+
+(cl-defgeneric gnus-search-run-search (engine server query groups)
+ "Run QUERY in GROUPS against SERVER, using search ENGINE.
+Should return results as a vector of vectors.")
+
+(cl-defgeneric gnus-search-transform (engine expression)
+ "Transform sexp EXPRESSION into a string search query usable by ENGINE.
+Responsible for handling and, or, and parenthetical expressions.")
+
+(cl-defgeneric gnus-search-transform-expression (engine expression)
+ "Transform a basic EXPRESSION into a string usable by ENGINE.")
+
+(cl-defgeneric gnus-search-make-query-string (engine query-spec)
+ "Extract the actual query string to use from QUERY-SPEC.")
+
+;; Methods that are likely to be the same for all engines.
+
+(cl-defmethod gnus-search-make-query-string ((engine gnus-search-engine)
+ query-spec)
+ (if (and gnus-search-use-parsed-queries
+ (null (alist-get 'raw query-spec))
+ (null (slot-value engine 'raw-queries-p)))
+ (gnus-search-transform
+ engine (alist-get 'parsed-query query-spec))
+ (alist-get 'query query-spec)))
+
+(defsubst gnus-search-single-p (query)
+ "Return t if QUERY is a search for a single message."
+ (let ((q (alist-get 'parsed-query query)))
+ (and (= (length q ) 1)
+ (consp (car-safe q))
+ (eq (caar q) 'id))))
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-engine)
+ (query list))
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (gnus-search-transform-expression engine item)))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+;; Most search engines just pass through plain strings.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (expr string))
+ expr)
+
+;; Most search engines use implicit ANDs.
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-engine)
+ (_expr (eql and)))
+ nil)
+
+;; Most search engines use explicit infixed ORs.
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ ;; Unhandled keywords return a nil; don't create an "or" expression
+ ;; unless both sub-expressions are non-nil.
+ (if (and left right)
+ (format "%s or %s" left right)
+ (or left right))))
+
+;; Most search engines just use the string "not"
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-engine)
+ (expr (head not)))
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (when next
+ (format "not %s" next))))
+
+;;; Search Engine Interfaces:
+
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
+;; imap interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-imap)
+ srv query groups)
+ (save-excursion
+ (let ((server (cadr (gnus-server-to-method srv)))
+ (gnus-inhibit-demon t)
+ ;; We're using the message id to look for a single message.
+ (single-search (gnus-search-single-p query))
+ (grouplist (or groups (gnus-search-get-active srv)))
+ q-string artlist group)
+ (message "Opening server %s" server)
+ ;; We should only be doing this once, in
+ ;; `nnimap-open-connection', but it's too frustrating to try to
+ ;; get to the server from the process buffer.
+ (with-current-buffer (nnimap-buffer)
+ (setf (slot-value engine 'literal-plus)
+ (when (nnimap-capability "LITERAL+") t))
+ ;; MULTISEARCH not yet implemented.
+ (setf (slot-value engine 'multisearch)
+ (when (nnimap-capability "MULTISEARCH") t))
+ ;; FUZZY only partially supported: the command is sent to the
+ ;; server (and presumably acted upon), but we don't yet
+ ;; request a RELEVANCY score as part of the response.
+ (setf (slot-value engine 'fuzzy)
+ (when (nnimap-capability "SEARCH=FUZZY") t)))
+
+ (setq q-string
+ (gnus-search-make-query-string engine query))
+
+ ;; If it's a thread query, make sure that all message-id
+ ;; searches are also references searches.
+ (when (alist-get 'thread query)
+ (setq q-string
+ (replace-regexp-in-string
+ "HEADER Message-Id \\([^ )]+\\)"
+ "(OR HEADER Message-Id \\1 HEADER References \\1)"
+ q-string)))
+
+ (while (and (setq group (pop grouplist))
+ (or (null single-search) (null artlist)))
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((result
+ (gnus-search-imap-search-command engine q-string)))
+ (when (car result)
+ (setq artlist
+ (vconcat
+ (mapcar
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (vector group artn 100))))
+ (cdr (assoc "SEARCH" (cdr result))))
+ artlist))))
+ (message "Searching %s...done" group))))
+ artlist)))
+
+(cl-defmethod gnus-search-imap-search-command ((engine gnus-search-imap)
+ (query string))
+ "Create the IMAP search command for QUERY.
+Currenly takes into account support for the LITERAL+ capability.
+Other capabilities could be tested here."
+ (with-slots (literal-plus) engine
+ (when literal-plus
+ (setq query (split-string query "\n")))
+ (cond
+ ((consp query)
+ ;; We're not really streaming, just need to prevent
+ ;; `nnimap-send-command' from waiting for a response.
+ (let* ((nnimap-streaming t)
+ (call
+ (nnimap-send-command
+ "UID SEARCH CHARSET UTF-8 %s"
+ (pop query))))
+ (dolist (l query)
+ (process-send-string (get-buffer-process (current-buffer)) l)
+ (process-send-string (get-buffer-process (current-buffer))
+ (if (nnimap-newlinep nnimap-object)
+ "\n"
+ "\r\n")))
+ (nnimap-get-response call)))
+ (t (nnimap-command "UID SEARCH %s" query)))))
+
+;; TODO: Don't exclude booleans and date keys, just check for them
+;; before checking for general keywords.
+(defvar gnus-search-imap-search-keys
+ '(body cc bcc from header keyword larger smaller subject text to uid)
+ "Known IMAP search keys, excluding booleans and date keys.")
+
+(cl-defmethod gnus-search-transform ((_ gnus-search-imap)
+ (_query null))
+ "ALL")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr string))
+ (unless (string-match-p "\\`/.+/\\'" expr)
+ ;; Also need to check for fuzzy here. Or better, do some
+ ;; refactoring of this stuff.
+ (format "TEXT %s"
+ (gnus-search-imap-handle-string engine expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head or)))
+ (let ((left (gnus-search-transform-expression engine (nth 1 expr)))
+ (right (gnus-search-transform-expression engine (nth 2 expr))))
+ (if (and left right)
+ (format "(OR %s %s)"
+ left (format (if (eq 'or (car-safe (nth 2 expr)))
+ "(%s)" "%s")
+ right))
+ (or left right))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head near)))
+ "Imap searches interpret \"near\" as \"or\"."
+ (setcar expr 'or)
+ (gnus-search-transform-expression engine expr))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr (head not)))
+ "Transform IMAP NOT.
+If the term to be negated is a flag, then use the appropriate UN*
+boolean instead."
+ (if (eql (caadr expr) 'mark)
+ (if (string= (cdadr expr) "new")
+ "OLD"
+ (format "UN%s" (gnus-search-imap-handle-flag (cdadr expr))))
+ (format "NOT %s"
+ (gnus-search-transform-expression engine (cadr expr)))))
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-imap)
+ (expr (head mark)))
+ (gnus-search-imap-handle-flag (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-imap)
+ (expr list))
+ "Handle a search keyword for IMAP.
+All IMAP search keywords that take a value are supported
+directly. Keywords that are boolean are supported through other
+means (usually the \"mark\" keyword)."
+ (let ((fuzzy-supported (slot-value engine 'fuzzy))
+ (fuzzy ""))
+ (cl-case (car expr)
+ (date (setcar expr 'on))
+ (tag (setcar expr 'keyword))
+ (sender (setcar expr 'from)))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eq (car expr) 'recipient)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr)))))
+ ((eq (car expr) 'address)
+ (gnus-search-transform
+ engine (gnus-search-parse-query
+ (format
+ "from:%s or to:%s or cc:%s or bcc:%s"
+ (cdr expr) (cdr expr) (cdr expr) (cdr expr)))))
+ ((memq (car expr) '(before since on sentbefore senton sentsince))
+ ;; Ignore dates given as strings.
+ (when (listp (cdr expr))
+ (format "%s %s"
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-date engine (cdr expr)))))
+ ((stringp (cdr expr))
+ ;; If the search term starts or ends with "*", remove the
+ ;; asterisk. If the engine supports FUZZY, then additionally make
+ ;; the search fuzzy.
+ (when (string-match "\\`\\*\\|\\*\\'" (cdr expr))
+ (setcdr expr (replace-regexp-in-string
+ "\\`\\*\\|\\*\\'" "" (cdr expr)))
+ (when fuzzy-supported
+ (setq fuzzy "FUZZY ")))
+ ;; If the search term is a regexp, drop the expression altogether.
+ (unless (string-match-p "\\`/.+/\\'" (cdr expr))
+ (cond
+ ((memq (car expr) gnus-search-imap-search-keys)
+ (format "%s%s %s"
+ fuzzy
+ (upcase (symbol-name (car expr)))
+ (gnus-search-imap-handle-string engine (cdr expr))))
+ ((eq (car expr) 'id)
+ (format "HEADER Message-ID \"%s\"" (cdr expr)))
+ ;; Treat what can't be handled as a HEADER search. Probably a bad
+ ;; idea.
+ (t (format "%sHEADER %s %s"
+ fuzzy
+ (car expr)
+ (gnus-search-imap-handle-string engine (cdr expr))))))))))
+
+(cl-defmethod gnus-search-imap-handle-date ((_engine gnus-search-imap)
+ (date list))
+ "Turn DATE into a date string recognizable by IMAP.
+While other search engines can interpret partially-qualified
+dates such as a plain \"January\", IMAP requires an absolute
+date.
+
+DATE is a list of (dd mm yyyy), any element of which could be
+nil. Massage those numbers into the most recent past occurrence
+of whichever date elements are present."
+ (let ((now (decode-time (current-time))))
+ ;; Set nil values to 1, current-month, current-year, or else 1, 1,
+ ;; current-year, depending on what we think the user meant.
+ (unless (seq-elt date 1)
+ (setf (seq-elt date 1)
+ (if (seq-elt date 0)
+ (seq-elt now 4)
+ 1)))
+ (unless (seq-elt date 0)
+ (setf (seq-elt date 0) 1))
+ (unless (seq-elt date 2)
+ (setf (seq-elt date 2)
+ (seq-elt now 5)))
+ ;; Fiddle with the date until it's in the past. There
+ ;; must be a way to combine all these steps.
+ (unless (< (seq-elt date 2)
+ (seq-elt now 5))
+ (when (< (seq-elt now 3)
+ (seq-elt date 0))
+ (cl-decf (seq-elt date 1)))
+ (cond ((zerop (seq-elt date 1))
+ (setf (seq-elt date 1) 1)
+ (cl-decf (seq-elt date 2)))
+ ((< (seq-elt now 4)
+ (seq-elt date 1))
+ (cl-decf (seq-elt date 2))))))
+ (format-time-string "%e-%b-%Y" (apply #'encode-time
+ (append '(0 0 0)
+ date))))
+
+(cl-defmethod gnus-search-imap-handle-string ((engine gnus-search-imap)
+ (str string))
+ (with-slots (literal-plus) engine
+ (if (multibyte-string-p str)
+ ;; If LITERAL+ is available, use it and encode string as
+ ;; UTF-8.
+ (if literal-plus
+ (format "{%d+}\n%s"
+ (string-bytes str)
+ (encode-coding-string str 'utf-8))
+ ;; Otherwise, if the user hasn't already quoted the string,
+ ;; quote it for them.
+ (if (string-prefix-p "\"" str)
+ str
+ (format "\"%s\"" str)))
+ str)))
+
+(defun gnus-search-imap-handle-flag (flag)
+ "Make sure string FLAG is something IMAP will recognize."
+ ;; What else? What about the KEYWORD search key?
+ (setq flag
+ (pcase flag
+ ("flag" "flagged")
+ ("read" "seen")
+ (_ flag)))
+ (if (member flag '("seen" "answered" "deleted" "draft" "flagged"))
+ (upcase flag)
+ ""))
+
+;;; Methods for the indexed search engines.
+
+;; First, some common methods.
+
+(cl-defgeneric gnus-search-indexed-parse-output (engine server &optional groups)
+ "Parse the results of ENGINE's query against SERVER in GROUPS.
+Locally-indexed search engines return results as a list of
+filenames, sometimes with additional information. Returns a list
+of viable results, in the form of a list of [group article score]
+vectors.")
+
+(cl-defgeneric gnus-search-index-extract (engine)
+ "Extract a single article result from the current buffer.
+Returns a list of two values: a file name, and a relevancy score.
+Advances point to the beginning of the next result.")
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-indexed)
+ server query groups)
+ "Run QUERY against SERVER using ENGINE.
+This method is common to all indexed search engines.
+
+Returns a list of [group article score] vectors."
+
+ (save-excursion
+ (let* ((qstring (gnus-search-make-query-string engine query))
+ (program (slot-value engine 'program))
+ (buffer (slot-value engine 'proc-buffer))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ proc exitstatus)
+ (set-buffer buffer)
+ (erase-buffer)
+
+ (if groups
+ (message "Doing %s query on %s..." program groups)
+ (message "Doing %s query..." program))
+ (setq proc (apply #'start-process (format "search-%s" server)
+ buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (setq exitstatus (process-exit-status proc))
+ (if (zerop exitstatus)
+ ;; The search results have been put into the current buffer;
+ ;; `parse-output' finds them there and returns the article
+ ;; list.
+ (gnus-search-indexed-parse-output engine server query groups)
+ (nnheader-report 'search "%s error: %s" program exitstatus)
+ ;; Failure reason is in this buffer, show it if the user
+ ;; wants it.
+ (when (> gnus-verbose 6)
+ (display-buffer buffer))
+ nil))))
+
+(cl-defmethod gnus-search-indexed-parse-output ((engine gnus-search-indexed)
+ server query &optional groups)
+ (let ((prefix (slot-value engine 'remove-prefix))
+ (group-regexp (when groups
+ (regexp-opt
+ (mapcar
+ (lambda (x) (gnus-group-real-name x))
+ groups))))
+ artlist vectors article group)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (pcase-let ((`(,f-name ,score) (gnus-search-indexed-extract engine)))
+ (when (and (file-readable-p f-name)
+ (null (file-directory-p f-name))
+ (or (null groups)
+ (and (gnus-search-single-p query)
+ (alist-get 'thread query))
+ (string-match-p group-regexp f-name)))
+ (push (list f-name score) artlist))))
+ ;; Are we running an additional grep query?
+ (when-let ((grep-reg (alist-get 'grep query)))
+ (setq artlist (gnus-search-grep-search engine artlist grep-reg)))
+ ;; Turn (file-name score) into [group article score].
+ (pcase-dolist (`(,f-name ,score) artlist)
+ (setq article (file-name-nondirectory f-name))
+ ;; Remove prefix.
+ (when (and prefix
+ (file-name-absolute-p prefix)
+ (string-match (concat "^"
+ (file-name-as-directory prefix))
+ f-name))
+ (setq group (replace-match "" t t (file-name-directory f-name))))
+ ;; Break the directory name down until it's something that
+ ;; (probably) can be used as a group name.
+ (setq group
+ (replace-regexp-in-string
+ "[/\\]" "."
+ (replace-regexp-in-string
+ "/?\\(cur\\|new\\|tmp\\)?/\\'" ""
+ (replace-regexp-in-string
+ "^[./\\]" ""
+ group nil t)
+ nil t)
+ nil t))
+
+ (push (vector (gnus-group-full-name group server)
+ (if (string-match-p "\\`[[:digit:]]+\\'" article)
+ (string-to-number article)
+ (nnmaildir-base-name-to-article-number
+ (substring article 0 (string-match ":" article))
+ group nil))
+ (if (numberp score)
+ score
+ (string-to-number score)))
+ vectors))
+ vectors))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-indexed))
+ "Base implementation treats the whole line as a filename, and
+fudges a relevancy score of 100."
+ (prog1
+ (list (buffer-substring-no-properties (line-beginning-position)
+ (line-end-position))
+ 100)
+ (forward-line 1)))
+
+;; Swish++
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-swish++)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ;; Untested and likely wrong.
+ ((and (stringp (cdr expr))
+ (string-prefix-p "(" (cdr expr)))
+ (format "%s = %s" (car expr) (gnus-search-transform
+ engine
+ (gnus-search-parse-query (cdr expr)))))
+ (t (format "%s = %s" (car expr) (cdr expr)))))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish++)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (config-file switches) engine
+ `("--config-file" ,config-file
+ ,@switches
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish++))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
+ (list (match-string 2)
+ (match-string 1))))
+
+;; Swish-e
+
+;; I didn't do the query transformation for Swish-e, because the
+;; program seems no longer to exist.
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-swish-e)
+ (qstring string)
+ _query &optional _groups)
+ (with-slots (index-files switches) engine
+ `("-f" ,@index-files
+ ,@switches
+ "-w"
+ ,qstring
+ )))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-swish-e))
+ (when (re-search-forward
+ "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
+ (list (match-string 3)
+ (match-string 1))))
+
+;; Namazu interface
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-namazu)
+ (expr list))
+ (cond
+ ((listp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'body)
+ (cadr expr))
+ ;; I have no idea which fields namazu can handle. Just do these
+ ;; for now.
+ ((memq (car expr) '(subject from to))
+ (format "+%s:%s" (car expr) (cdr expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eq (car expr) 'id)
+ (format "+message-id:%s" (cdr expr)))
+ (t (ignore-errors (cl-call-next-method)))))
+
+;; I can't tell if this is actually necessary.
+(cl-defmethod gnus-search-run-search :around ((_e gnus-search-namazu)
+ _server _query _groups)
+ (let ((process-environment (copy-sequence process-environment)))
+ (setenv "LC_MESSAGES" "C")
+ (cl-call-next-method)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-namazu)
+ (qstring string)
+ query &optional _groups)
+ (let ((max (alist-get 'limit query)))
+ (with-slots (switches index-directory) engine
+ (append
+ (list "-q" ; don't be verbose
+ "-a" ; show all matches
+ "-s") ; use short format
+ (when max (list (format "--max=%d" max)))
+ switches
+ (list qstring index-directory)))))
+
+(cl-defmethod gnus-search-indexed-extract ((_engine gnus-search-namazu))
+ "Extract a single message result for Namazu.
+Namazu provides a little more information, for instance a score."
+
+ (when (re-search-forward
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ nil t)
+ (list (match-string 4)
+ (match-string 3))))
+
+;;; Notmuch interface
+
+(cl-defmethod gnus-search-transform ((_engine gnus-search-notmuch)
+ (_query null))
+ "*")
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr (head near)))
+ (format "%s near %s"
+ (gnus-search-transform-expression engine (nth 1 expr))
+ (gnus-search-transform-expression engine (nth 2 expr))))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-notmuch)
+ (expr list))
+ ;; Swap keywords as necessary.
+ (cl-case (car expr)
+ (sender (setcar expr 'from))
+ ;; Notmuch's "to" is already equivalent to our "recipient".
+ (recipient (setcar expr 'to))
+ (mark (setcar expr 'tag)))
+ ;; Then actually format the results.
+ (cl-flet ((notmuch-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))
+ (`(,d ,m nil)
+ (format "%02d-%02d" d m))
+ (`(nil ,m ,y)
+ (format "%02d-%d" m y))
+ (`(,d ,m ,y)
+ (format "%d/%d/%d" m d y))))))
+ (cond
+ ((consp (car expr))
+ (format "(%s)" (gnus-search-transform engine expr)))
+ ((eql (car expr) 'address)
+ (gnus-search-transform engine `((or (from . ,(cdr expr))
+ (to . ,(cdr expr))))))
+ ((eql (car expr) 'body)
+ (cdr expr))
+ ((memq (car expr) '(from to subject attachment mimetype tag id
+ thread folder path lastmod query property))
+ ;; Notmuch requires message-id with no angle brackets.
+ (when (eql (car expr) 'id)
+ (setcdr
+ expr (replace-regexp-in-string "\\`<\\|>\\'" "" (cdr expr))))
+ (format "%s:%s" (car expr)
+ (if (string-match "\\`\\*" (cdr expr))
+ ;; Notmuch can only handle trailing asterisk
+ ;; wildcards, so strip leading asterisks.
+ (replace-match "" nil nil (cdr expr))
+ (cdr expr))))
+ ((eq (car expr) 'date)
+ (format "date:%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'before)
+ (format "date:..%s" (notmuch-date (cdr expr))))
+ ((eq (car expr) 'since)
+ (format "date:%s.." (notmuch-date (cdr expr))))
+ (t (ignore-errors (cl-call-next-method))))))
+
+(cl-defmethod gnus-search-run-search :around ((engine gnus-search-notmuch)
+ server query groups)
+ "Handle notmuch's thread-search routine."
+ ;; Notmuch allows for searching threads, but only using its own
+ ;; thread ids. That means a thread search is a \"double-bounce\":
+ ;; once to find the relevant thread ids, and again to find the
+ ;; actual messages. This method performs the first \"bounce\".
+ (if (alist-get 'thread query)
+ (with-slots (program proc-buffer) engine
+ (let* ((qstring
+ (gnus-search-make-query-string engine query))
+ (cp-list (gnus-search-indexed-search-command
+ engine qstring query groups))
+ thread-ids proc)
+ (set-buffer proc-buffer)
+ (erase-buffer)
+ (setq proc (apply #'start-process (format "search-%s" server)
+ proc-buffer program cp-list))
+ (while (process-live-p proc)
+ (accept-process-output proc))
+ (while (re-search-forward "^thread:\\([^ ]+\\)" (point-max) t)
+ (push (match-string 1) thread-ids))
+ (cl-call-next-method
+ engine server
+ ;; Completely replace the query with our new thread-based one.
+ (mapconcat (lambda (thrd) (concat "thread:" thrd))
+ thread-ids " or ")
+ nil)))
+ (cl-call-next-method engine server query groups)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-notmuch)
+ (qstring string)
+ query &optional _groups)
+ ;; Theoretically we could use the GROUPS parameter to pass a
+ ;; --folder switch to notmuch, but I'm not confident of getting the
+ ;; format right.
+ (let ((limit (alist-get 'limit query))
+ (thread (alist-get 'thread query)))
+ (with-slots (switches config-file) engine
+ `(,(format "--config=%s" config-file)
+ "search"
+ ,(if thread
+ "--output=threads"
+ "--output=files")
+ "--duplicate=1" ; I have found this necessary, I don't know why.
+ ,@switches
+ ,(if limit (format "--limit=%d" limit) "")
+ ,qstring
+ ))))
+
+;;; Mairix interface
+
+;; See the Gnus manual for why mairix searching is a bit weird.
+
+(cl-defmethod gnus-search-transform ((engine gnus-search-mairix)
+ (query list))
+ "Transform QUERY for a Mairix engine.
+Because Mairix doesn't accept parenthesized expressions, nor
+\"or\" statements between different keys, results may differ from
+other engines. We unpeel parenthesized expressions, and just
+cross our fingers for the rest of it."
+ (let (clauses)
+ (mapc
+ (lambda (item)
+ (when-let ((expr (if (consp (car-safe item))
+ (gnus-search-transform engine item)
+ (gnus-search-transform-expression engine item))))
+ (push expr clauses)))
+ query)
+ (mapconcat #'identity (reverse clauses) " ")))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head not)))
+ "Transform Mairix \"not\".
+Mairix negation requires a \"~\" preceding string search terms,
+and \"-\" before marks."
+ (let ((next (gnus-search-transform-expression engine (cadr expr))))
+ (replace-regexp-in-string
+ ":"
+ (if (eql (caadr expr) 'mark)
+ ":-"
+ ":~")
+ next)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr (head or)))
+ "Handle Mairix \"or\" statement.
+Mairix only accepts \"or\" expressions on homogenous keys. We
+cast \"or\" expressions on heterogenous keys as \"and\", which
+isn't quite right, but it's the best we can do. For date keys,
+only keep one of the terms."
+ (let ((term1 (caadr expr))
+ (term2 (caaddr expr))
+ (val1 (gnus-search-transform-expression engine (nth 1 expr)))
+ (val2 (gnus-search-transform-expression engine (nth 2 expr))))
+ (cond
+ ((or (listp term1) (listp term2))
+ (concat val1 " " val2))
+ ((and (member (symbol-name term1) gnus-search-date-keys)
+ (member (symbol-name term2) gnus-search-date-keys))
+ (or val1 val2))
+ ((eql term1 term2)
+ (if (and val1 val2)
+ (format "%s/%s"
+ val1
+ (nth 1 (split-string val2 ":")))
+ (or val1 val2)))
+ (t (concat val1 " " val2)))))
+
+
+(cl-defmethod gnus-search-transform-expression ((_ gnus-search-mairix)
+ (expr (head mark)))
+ (gnus-search-mairix-handle-mark (cdr expr)))
+
+(cl-defmethod gnus-search-transform-expression ((engine gnus-search-mairix)
+ (expr list))
+ (let ((key (cl-case (car expr)
+ (sender "f")
+ (from "f")
+ (to "t")
+ (cc "c")
+ (subject "s")
+ (id "m")
+ (body "b")
+ (address "a")
+ (recipient "tc")
+ (text "bs")
+ (attachment "n")
+ (t nil))))
+ (cond
+ ((consp (car expr))
+ (gnus-search-transform engine expr))
+ ((member (symbol-name (car expr)) gnus-search-date-keys)
+ (gnus-search-mairix-handle-date expr))
+ ((memq (car expr) '(size smaller larger))
+ (gnus-search-mairix-handle-size expr))
+ ;; Drop regular expressions.
+ ((string-match-p "\\`/" (cdr expr))
+ nil)
+ ;; Turn parenthesized phrases into multiple word terms. Again,
+ ;; this isn't quite what the user is asking for, but better to
+ ;; return false positives.
+ ((and key (string-match-p "[[:blank:]]" (cdr expr)))
+ (mapconcat
+ (lambda (s) (format "%s:%s" key s))
+ (split-string (gnus-search-mairix-treat-string
+ (cdr expr)))
+ " "))
+ (key (format "%s:%s" key
+ (gnus-search-mairix-treat-string
+ (cdr expr))))
+ (t nil))))
+
+(defun gnus-search-mairix-treat-string (str)
+ "Treat string for wildcards.
+Mairix accepts trailing wildcards, but not leading. Also remove
+double quotes."
+ (replace-regexp-in-string
+ "\\`\\*\\|\"" ""
+ (replace-regexp-in-string "\\*\\'" "=" str)))
+
+(defun gnus-search-mairix-handle-size (expr)
+ "Format a mairix size search.
+Assume \"size\" key is equal to \"larger\"."
+ (format
+ (if (eql (car expr) 'smaller)
+ "z:-%s"
+ "z:%s-")
+ (cdr expr)))
+
+(defun gnus-search-mairix-handle-mark (expr)
+ "Format a mairix mark search."
+ (let ((mark
+ (pcase (cdr expr)
+ ("flag" "f")
+ ("read" "s")
+ ("seen" "s")
+ ("replied" "r")
+ (_ nil))))
+ (when mark
+ (format "F:%s" mark))))
+
+(defun gnus-search-mairix-handle-date (expr)
+ (let ((str
+ (pcase (cdr expr)
+ (`(nil ,m nil)
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3))
+ (`(nil nil ,y)
+ (number-to-string y))
+ (`(,d ,m nil)
+ (format "%s%02d"
+ (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)
+ d))
+ (`(nil ,m ,y)
+ (format "%d%s"
+ y (substring
+ (nth (1- m) gnus-english-month-names)
+ 0 3)))
+ (`(,d ,m ,y)
+ (format "%d%02d%02d" y m d)))))
+ (format
+ (pcase (car expr)
+ ('date "d:%s")
+ ('since "d:%s-")
+ ('after "d:%s-")
+ ('before "d:-%s"))
+ str)))
+
+(cl-defmethod gnus-search-indexed-search-command ((engine gnus-search-mairix)
+ (qstring string)
+ query &optional _groups)
+ (with-slots (switches config-file) engine
+ (append `("--rcfile" ,config-file "-r")
+ switches
+ (when (alist-get 'thread query) (list "-t"))
+ (list qstring))))
+
+;;; Find-grep interface
+
+(cl-defmethod gnus-search-transform-expression ((_engine gnus-search-find-grep)
+ (_ list))
+ ;; Drop everything that isn't a plain string.
+ nil)
+
+(cl-defmethod gnus-search-run-search ((engine gnus-search-find-grep)
+ server query
+ &optional groups)
+ "Run find and grep to obtain matching articles."
+ (let* ((method (gnus-server-to-method server))
+ (sym (intern
+ (concat (symbol-name (car method)) "-directory")))
+ (directory (cadr (assoc sym (cddr method))))
+ (regexp (alist-get 'grep query))
+ (grep-options (slot-value engine 'grep-options))
+ (grouplist (or groups (gnus-search-get-active server)))
+ (buffer (slot-value engine 'proc-buffer)))
+ (unless directory
+ (error "No directory found in method specification of server %s"
+ server))
+ (apply
+ 'vconcat
+ (mapcar (lambda (x)
+ (let ((group x)
+ artlist)
+ (message "Searching %s using find-grep..."
+ (or group server))
+ (save-window-excursion
+ (set-buffer buffer)
+ (if (> gnus-verbose 6)
+ (pop-to-buffer (current-buffer)))
+ (cd directory) ; Using relative paths simplifies
+ ; postprocessing.
+ (let ((group
+ (if (not group)
+ "."
+ ;; Try accessing the group literally as
+ ;; well as interpreting dots as directory
+ ;; separators so the engine works with
+ ;; plain nnml as well as the Gnus Cache.
+ (let ((group (gnus-group-real-name group)))
+ ;; Replace cl-func find-if.
+ (if (file-directory-p group)
+ group
+ (if (file-directory-p
+ (setq group
+ (replace-regexp-in-string
+ "\\." "/"
+ group nil t)))
+ group))))))
+ (unless group
+ (error "Cannot locate directory for group"))
+ (save-excursion
+ (apply
+ 'call-process "find" nil t
+ "find" group "-maxdepth" "1" "-type" "f"
+ "-name" "[0-9]*" "-exec"
+ (slot-value engine 'grep-program)
+ `("-l" ,@(and grep-options
+ (split-string grep-options "\\s-" t))
+ "-e" ,regexp "{}" "+"))))
+
+ ;; Translate relative paths to group names.
+ (while (not (eobp))
+ (let* ((path (split-string
+ (buffer-substring
+ (point)
+ (line-end-position)) "/" t))
+ (art (string-to-number (car (last path)))))
+ (while (string= "." (car path))
+ (setq path (cdr path)))
+ (let ((group (mapconcat #'identity
+ (cl-subseq path 0 -1)
+ ".")))
+ (push
+ (vector (gnus-group-full-name group server) art 0)
+ artlist))
+ (forward-line 1)))
+ (message "Searching %s using find-grep...done"
+ (or group server))
+ artlist)))
+ grouplist))))
+
+(declare-function mm-url-insert "mm-url" (url &optional follow-refresh))
+(declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs))
+
+;; gmane interface
+(cl-defmethod gnus-search-run-search ((engine gnus-search-gmane)
+ srv query &optional groups)
+ "Run a search against a gmane back-end server."
+ (let* ((case-fold-search t)
+ (groupspec (mapconcat
+ (lambda (x)
+ (if (string-match-p "gmane" x)
+ (format "group:%s" (gnus-group-short-name x))
+ (error "Can't search non-gmane groups: %s" x)))
+ groups " "))
+ (buffer (slot-value engine 'proc-buffer))
+ (search (concat (gnus-search-make-query-string engine query)
+ " "
+ groupspec))
+ (gnus-inhibit-demon t)
+ artlist)
+ (require 'mm-url)
+ (with-current-buffer buffer
+ (erase-buffer)
+ (mm-url-insert
+ (concat
+ "http://search.gmane.org/nov.php"
+ "?"
+ (mm-url-encode-www-form-urlencoded
+ `(("query" . ,search)
+ ("HITSPERPAGE" . "999")))))
+ (set-buffer-multibyte t)
+ (decode-coding-region (point-min) (point-max) 'utf-8)
+ (goto-char (point-min))
+ (forward-line 1)
+ (while (not (eobp))
+ (unless (or (eolp) (looking-at "\x0d"))
+ (let ((header (nnheader-parse-nov)))
+ (let ((xref (mail-header-xref header))
+ (xscore (string-to-number (cdr (assoc 'X-Score
+ (mail-header-extra header))))))
+ (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
+ (push
+ (vector
+ (gnus-group-prefixed-name (match-string 1 xref) srv)
+ (string-to-number (match-string 2 xref)) xscore)
+ artlist)))))
+ (forward-line 1)))
+ (apply #'vector (nreverse (delete-dups artlist)))))
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head near)))
+ nil)
+
+;; Can Gmane handle OR or NOT keywords?
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head or)))
+ nil)
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (_expr (head not)))
+ nil)
+
+(cl-defmethod gnus-search-transform-expression ((_e gnus-search-gmane)
+ (expr list))
+ "The only keyword value gmane can handle is author, ie from."
+ (cond
+ ((memq (car expr) '(from sender author address))
+ (format "author:%s" (cdr expr)))
+ ((eql (car expr) 'body)
+ (cdr expr))))
+
+;;; Util Code:
+
+(defun gnus-search-run-query (specs)
+ "Invoke appropriate search engine function."
+ ;; For now, run the searches synchronously. At some point
+ ;; multiple-server searches can each be run in their own thread,
+ ;; allowing concurrent searches of multiple backends. At present
+ ;; this causes problems when searching more than one server that
+ ;; uses `nntp-server-buffer', as their return values are written
+ ;; interleaved into that buffer. Anyway, that's the reason for the
+ ;; `mapc'.
+ (let* ((results [])
+ (prepared-query (gnus-search-prepare-query
+ (alist-get 'search-query-spec specs)))
+ (limit (alist-get 'limit prepared-query)))
+ (mapc
+ (pcase-lambda (`(,server . ,groups))
+ (let ((search-engine (gnus-search-server-to-engine server)))
+ (setq results
+ (vconcat
+ (gnus-search-run-search
+ search-engine server prepared-query groups)
+ results))))
+ (alist-get 'search-group-spec specs))
+ ;; Some search engines do their own limiting, but some don't, so
+ ;; do it again here. This is bad because, if the user is
+ ;; searching multiple groups, they would reasonably expect the
+ ;; limiting to apply to the search results *after sorting*. Doing
+ ;; it this way is liable to, for instance, eliminate all results
+ ;; from a later group entirely.
+ (if limit
+ (seq-subseq results 0 (min limit (length results)))
+ results)))
+
+(defun gnus-search-prepare-query (query-spec)
+ "Accept a search query in raw format, and prepare it.
+QUERY-SPEC is an alist produced by functions such as
+`gnus-group-make-search-group', and contains at least a 'query
+key, and possibly some meta keys. This function extracts any
+additional meta keys from the 'query string, and parses the
+remaining string, then adds all that to the top-level spec."
+ (let ((query (alist-get 'query query-spec))
+ val)
+ (when (stringp query)
+ ;; Look for these meta keys:
+ (while (string-match
+ "\\(thread\\|grep\\|limit\\|raw\\):\\([^ ]+\\)"
+ query)
+ (setq val (match-string 2 query))
+ (setf (alist-get (intern (match-string 1 query)) query-spec)
+ ;; This is stupid.
+ (cond
+ ((equal val "t"))
+ ((null (zerop (string-to-number val)))
+ (string-to-number val))
+ (t val)))
+ (setq query
+ (string-trim (replace-match "" t t query 0)))
+ (setf (alist-get 'query query-spec) query)))
+ (when gnus-search-use-parsed-queries
+ (setf (alist-get 'parsed-query query-spec)
+ (gnus-search-parse-query query)))
+ query-spec))
+
+;; This should be done once at Gnus startup time, when the servers are
+;; first opened, and the resulting engine instance attached to the
+;; server.
+(defun gnus-search-server-to-engine (srv)
+ (let* ((method (gnus-server-to-method srv))
+ (server
+ (or (assoc 'gnus-search-engine (cddr method))
+ (assoc (car method) gnus-search-default-engines)
+ (when-let ((old (assoc 'nnir-search-engine
+ (cddr method))))
+ (nnheader-message
+ 8 "\"nnir-search-engine\" is no longer a valid parameter")
+ (pcase old
+ ('notmuch 'gnus-search-notmuch)
+ ('namazu 'gnus-search-namazu)
+ ('find-grep 'gnus-search-find-grep)))))
+ (inst
+ (cond
+ ((null server) nil)
+ ((eieio-object-p (cadr server))
+ (cadr server))
+ ((class-p (cadr server))
+ (make-instance (cadr server)))
+ (t nil))))
+ (if inst
+ (when (cddr server)
+ (pcase-dolist (`(,key ,value) (cddr server))
+ (condition-case nil
+ (setf (slot-value inst key) value)
+ ((invalid-slot-name invalid-slot-type)
+ (nnheader-message
+ 5 "Invalid search engine parameter: (%s %s)"
+ key value)))))
+ (nnheader-message 5 "No search engine defined for %s" srv))
+ inst))
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
+(defun gnus-search-thread (header)
+ "Make an nnselect group based on the thread containing the article
+header. The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server
+ (cl-pushnew (list registry-server) server :test #'equal))
+ (gnus-group-make-search-group nil (list
+ (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+(defun gnus-search-get-active (srv)
+ (let ((method (gnus-server-to-method srv))
+ groups)
+ (gnus-request-list method)
+ (with-current-buffer nntp-server-buffer
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (unless (or (null gnus-search-ignored-newsgroups)
+ (string= gnus-search-ignored-newsgroups ""))
+ (delete-matching-lines gnus-search-ignored-newsgroups))
+ (if (eq (car method) 'nntp)
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (gnus-group-full-name
+ (buffer-substring
+ (point)
+ (progn
+ (skip-chars-forward "^ \t")
+ (point)))
+ method))
+ groups))
+ (forward-line))
+ (while (not (eobp))
+ (ignore-errors
+ (push (gnus-group-decoded-name
+ (if (eq (char-after) ?\")
+ (gnus-group-full-name (read cur) method)
+ (let ((p (point)) (name ""))
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (buffer-substring p (point)))
+ (while (eq (char-after) ?\\)
+ (setq p (1+ (point)))
+ (forward-char 2)
+ (skip-chars-forward "^ \t\\\\")
+ (setq name (concat name (buffer-substring
+ p (point)))))
+ (gnus-group-full-name name method))))
+ groups))
+ (forward-line)))))
+ groups))
+
+(defvar gnus-search-minibuffer-map
+ (let ((km (make-sparse-keymap)))
+ (set-keymap-parent km minibuffer-local-map)
+ (define-key km (kbd "TAB") #'completion-at-point)
+ km))
+
+(defun gnus-search--complete-key-data ()
+ "Potentially return completion data for a search key or value."
+ (let* ((key-start (save-excursion
+ (if (re-search-backward " " (minibuffer-prompt-end) t)
+ (1+ (point))
+ (minibuffer-prompt-end))))
+ (after-colon (save-excursion
+ (when (re-search-backward ":" key-start t)
+ (1+ (point)))))
+ in-string)
+ (if after-colon
+ ;; We're in the value part of a key:value pair, which we
+ ;; only handle in a contact-completion context.
+ (when (and gnus-search-contact-tables
+ (save-excursion
+ (re-search-backward "\\<\\(\\w+\\):" key-start t)
+ (member (match-string 1)
+ '("from" "to" "cc"
+ "bcc" "recipient" "address"))))
+ (setq in-string (nth 3 (syntax-ppss)))
+ (list (if in-string (1+ after-colon) after-colon)
+ (point) (apply #'completion-table-merge
+ gnus-search-contact-tables)
+ :exit-function
+ (lambda (str status)
+ ;; If the value contains spaces, make sure it's
+ ;; quoted.
+ (when (and (memql status '(exact finished))
+ (string-match-p " " str))
+ (unless (looking-at-p "\\s\"")
+ (insert "\""))
+ ;; Unless we already have an opening quote...
+ (unless in-string
+ (save-excursion
+ (goto-char after-colon)
+ (insert "\"")))))))
+ (list
+ key-start (point) gnus-search-expandable-keys
+ :exit-function (lambda (_s status)
+ (when (memql status '(exact finished))
+ (insert ":")))))))
+
+(defun gnus-search-make-spec (arg)
+ (list (cons 'query
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (add-hook 'completion-at-point-functions
+ #'gnus-search--complete-key-data))
+ (read-from-minibuffer
+ "Query: " nil gnus-search-minibuffer-map
+ nil 'gnus-search-history)))
+ (cons 'raw arg)))
+
+(provide 'gnus-search)
+;;; gnus-search.el ends here
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
index 21206b683c..ce2e99de05 100644
--- a/lisp/gnus/nnselect.el
+++ b/lisp/gnus/nnselect.el
@@ -36,10 +36,10 @@
;; sorting. Most functions will just chose a fixed number, such as
;; 100, for this score.
-;; For example the search function `nnir-run-query' applied to
-;; arguments specifying a search query (see "nnir.el") can be used to
-;; return a list of articles from a search. Or the function can be the
-;; identity and the args a vector of articles.
+;; For example the search function `gnus-search-run-query' applied to
+;; arguments specifying a search query (see "gnus-search.el") can be
+;; used to return a list of articles from a search. Or the function
+;; can be the identity and the args a vector of articles.
;;; Code:
@@ -47,7 +47,7 @@
;;; Setup:
(require 'gnus-art)
-(require 'nnir)
+(require 'gnus-search)
(eval-when-compile (require 'cl-lib))
@@ -372,25 +372,25 @@ nnselect-request-article
;; find the servers for a pseudo-article
(if (eq 'nnselect (car (gnus-server-to-method server)))
(with-current-buffer gnus-summary-buffer
- (let ((thread (gnus-id-to-thread article)))
+ (let ((thread (gnus-id-to-thread article)))
(when thread
(mapc
- #'(lambda (x)
- (when (and x (> x 0))
- (cl-pushnew
- (list
- (gnus-method-to-server
- (gnus-find-method-for-group
- (nnselect-article-group x)))) servers :test 'equal)))
+ (lambda (x)
+ (when (and x (> x 0))
+ (cl-pushnew
+ (list
+ (gnus-method-to-server
+ (gnus-find-method-for-group
+ (nnselect-article-group x)))) servers :test 'equal)))
(gnus-articles-in-thread thread)))))
(setq servers (list (list server))))
(setq artlist
- (nnir-run-query
+ (gnus-search-run-query
(list
- (cons 'nnir-query-spec
- (list (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "") (cons 'shortcut t)))
- (cons 'nnir-group-spec servers))))
+ (cons 'search-query-spec
+ (list (cons 'query `((id . ,article)))
+ (cons 'criteria "") (cons 'shortcut t)))
+ (cons 'search-group-spec servers))))
(unless (zerop (nnselect-artlist-length artlist))
(setq
group-art
@@ -603,26 +603,35 @@ nnselect-request-thread
(cl-some #'(lambda (x)
(when (and x (> x 0)) x))
(gnus-articles-in-thread thread)))))))))
- ;; Check if we are dealing with an imap backend.
- (if (eq 'nnimap
- (car (gnus-find-method-for-group artgroup)))
+ ;; Check if search-based thread referral is permitted, and
+ ;; available.
+ (if (and gnus-refer-thread-use-search
+ (gnus-search-server-to-engine
+ (gnus-method-to-server
+ (gnus-find-method-for-group artgroup))))
;; If so we perform the query, massage the result, and return
;; the new headers back to the caller to incorporate into the
;; current summary buffer.
(let* ((group-spec
(list (delq nil (list
(or server (gnus-group-server artgroup))
- (unless gnus-refer-thread-use-search
+ (unless gnus-refer-thread-use-search
artgroup)))))
+ (ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
(query-spec
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(last (nnselect-artlist-length gnus-newsgroup-selection))
(first (1+ last))
(new-nnselect-artlist
- (nnir-run-query
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec))))
+ (gnus-search-run-query
+ (list (cons 'search-query-spec query-spec)
+ (cons 'search-group-spec group-spec))))
old-arts seq
headers)
(mapc
@@ -670,7 +679,7 @@ nnselect-request-thread
group
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection))))
headers)
- ;; If not an imap backend just warp to the original article
+ ;; If we can't or won't use search, just warp to the original
;; group and punt back to gnus-summary-refer-thread.
(and (gnus-warp-to-article) (gnus-summary-refer-thread))))))
@@ -768,9 +777,15 @@ nnselect-search-thread
The current server will be searched. If the registry is
installed, the server that the registry reports the current
article came from is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
+ (let* ((ids (cons (mail-header-id header)
+ (split-string
+ (or (mail-header-references header)
+ ""))))
+ (query
+ (list (cons 'query (mapconcat (lambda (i)
+ (format "id:%s" i))
+ ids " or "))
+ (cons 'thread t)))
(server
(list (list (gnus-method-to-server
(gnus-find-method-for-group gnus-newsgroup-name)))))
@@ -794,10 +809,10 @@ nnselect-search-thread
(list
(cons 'nnselect-specs
(list
- (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-function 'gnus-search-run-query)
(cons 'nnselect-args
- (list (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))))
+ (list (cons 'search-query-spec query)
+ (cons 'search-group-spec server)))))
(cons 'nnselect-artlist nil)))
(gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
@@ -929,18 +944,18 @@ nnselect-push-info
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
-(defun gnus-summary-make-search-group (nnir-extra-parms)
+(defun gnus-summary-make-search-group (no-parse)
"Search a group from the summary buffer.
-Pass NNIR-EXTRA-PARMS on to the search engine."
+Pass NO-PARSE on to the search engine."
(interactive "P")
(gnus-warp-to-article)
(let ((spec
(list
- (cons 'nnir-group-spec
+ (cons 'search-group-spec
(list (list
(gnus-group-server gnus-newsgroup-name)
gnus-newsgroup-name))))))
- (gnus-group-make-search-group nnir-extra-parms spec)))
+ (gnus-group-make-search-group no-parse spec)))
;; The end.
diff --git a/test/lisp/gnus/gnus-search-tests.el b/test/lisp/gnus/gnus-search-tests.el
new file mode 100644
index 0000000000..5bae9cb14d
--- /dev/null
+++ b/test/lisp/gnus/gnus-search-tests.el
@@ -0,0 +1,96 @@
+;;; gnus-search-tests.el --- Tests for Gnus' search routines -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Eric Abrahamsen <eric@ericabrahamsen.net>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Tests for the search parsing, search engines, and their
+;; transformations.
+
+;;; Code:
+
+(require 'ert)
+(require 'gnus-search)
+
+(ert-deftest gnus-s-parse ()
+ "Test basic structural parsing."
+ (let ((pairs
+ '(("string" . ("string"))
+ ("from:john" . ((from . "john")))
+ ("here and there" . ("here" and "there"))
+ ("here or there" . ((or "here" "there")))
+ ("here (there or elsewhere)" . ("here" ((or "there" "elsewhere"))))
+ ("here not there" . ("here" (not "there")))
+ ("from:boss or not vacation" . ((or (from . "boss") (not "vacation")))))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-parse-query (car p)) (cdr p))))))
+
+(ert-deftest gnus-s-expand-keyword ()
+ "Test expansion of keywords"
+ (let ((gnus-search-expandable-keys
+ (default-value 'gnus-search-expandable-keys))
+ (pairs
+ '(("su" . "subject")
+ ("sin" . "since"))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-expand-key (car p))
+ (cdr p))))
+ (should-error (gnus-search-query-expand-key "s")
+ :type 'gnus-search-parse-error)))
+
+(ert-deftest gnus-s-parse-date ()
+ "Test parsing of date expressions."
+ (let ((rel-date (encode-time 0 0 0 15 4 2017))
+ (pairs
+ '(("January" . (nil 1 nil))
+ ("2017" . (nil nil 2017))
+ ("15" . (15 nil nil))
+ ("January 15" . (15 1 nil))
+ ("tuesday" . (11 4 2017))
+ ("1d" . (14 4 2017))
+ ("1w" . (8 4 2017)))))
+ (dolist (p pairs)
+ (should (equal (gnus-search-query-parse-date (car p) rel-date)
+ (cdr p))))))
+
+(ert-deftest gnus-s-delimited-string ()
+ "Test proper functioning of `gnus-search-query-return-string'."
+ (with-temp-buffer
+ (insert "one\ntwo words\nthree \"words with quotes\"\n\"quotes at start\"\n/alternate \"quotes\"/\n(more bits)")
+ (goto-char (point-min))
+ (should (string= (gnus-search-query-return-string)
+ "one"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "two"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string)
+ "three"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "\"")
+ "\"quotes at start\""))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string "/")
+ "/alternate \"quotes\"/"))
+ (forward-line)
+ (should (string= (gnus-search-query-return-string ")" t)
+ "more bits"))))
+
+(provide 'gnus-search-tests)
+;;; search-tests.el ends here
--
2.29.1
^ permalink raw reply related [flat|nested] 14+ messages in thread
* bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
2020-11-02 20:11 ` Eric Abrahamsen
@ 2020-11-04 5:22 ` Eric Abrahamsen
0 siblings, 0 replies; 14+ messages in thread
From: Eric Abrahamsen @ 2020-11-04 5:22 UTC (permalink / raw)
To: 44016, 44016-done
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> Okay, I think this is Close Enough. I'm going to sit on it for a couple
> of days, then push.
There goes. I'll keep an eye out for bugs. Closing this now.
^ permalink raw reply [flat|nested] 14+ messages in thread
end of thread, other threads:[~2020-11-04 5:22 UTC | newest]
Thread overview: 14+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-10-15 16:47 bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus Eric Abrahamsen
2020-10-16 5:08 ` Lars Ingebrigtsen
2020-10-16 15:49 ` Eric Abrahamsen
2020-11-01 5:32 ` Eric Abrahamsen
2020-11-01 18:10 ` Basil L. Contovounesios
2020-11-01 18:22 ` Eli Zaretskii
2020-11-01 21:19 ` Eric Abrahamsen
2020-11-01 21:38 ` Eric Abrahamsen
2020-11-01 23:50 ` Stefan Monnier
2020-11-02 3:43 ` Eric Abrahamsen
2020-11-02 14:24 ` Stefan Monnier
2020-11-02 16:16 ` Eric Abrahamsen
2020-11-02 20:11 ` Eric Abrahamsen
2020-11-04 5:22 ` Eric Abrahamsen
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).