From: Eric Abrahamsen <eric@ericabrahamsen.net>
To: 44016@debbugs.gnu.org
Subject: bug#44016: 28.0.50; Add new "gnus-search" search interface to Gnus
Date: Mon, 02 Nov 2020 12:11:47 -0800 [thread overview]
Message-ID: <877dr3bjss.fsf@ericabrahamsen.net> (raw)
In-Reply-To: <87blgfbuof.fsf@ericabrahamsen.net> (Eric Abrahamsen's message of "Mon, 02 Nov 2020 08:16:48 -0800")
[-- 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
next prev parent reply other threads:[~2020-11-02 20:11 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
2020-11-04 5:22 ` Eric Abrahamsen
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=877dr3bjss.fsf@ericabrahamsen.net \
--to=eric@ericabrahamsen.net \
--cc=44016@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).