From: Eric Abrahamsen Date: Fri, 16 Oct 2020 16:34:06 +0000 (-0700) Subject: Move nnir.el to lisp/obsolete X-Git-Tag: emacs-28.0.90~5256 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0328b21d1e44f0b5ec2001e2347743ec69159260;p=emacs.git Move nnir.el to lisp/obsolete * lisp/obsolete/nnir.el: This is no longer used, but users might still be requiring it. --- diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el deleted file mode 100644 index 20f82e5cbdf..00000000000 --- a/lisp/gnus/nnir.el +++ /dev/null @@ -1,1377 +0,0 @@ -;;; nnir.el --- Search mail with various search engines -*- lexical-binding:t -*- - -;; Copyright (C) 1998-2020 Free Software Foundation, Inc. - -;; Author: Kai Großjohann -;; Swish-e and Swish++ backends by: -;; Christoph Conrad . -;; IMAP backend by: Simon Josefsson . -;; IMAP search by: Torsten Hilbrich gmx.net> -;; IMAP search improved by Daniel Pittman . -;; nnmaildir support for Swish++ and Namazu backends by: -;; Justus Piater Piater.name> -;; Mostly rewritten by Andrew Cohen from 2010 -;; Keywords: news mail searching ir - -;; This file is part of GNU Emacs. - -;; GNU Emacs 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. - -;; GNU Emacs 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 GNU Emacs. If not, see . - -;;; Commentary: - -;; What does it do? Well, it searches your mail using some search -;; engine (imap, namazu, swish-e, gmane and others -- see later). - -;; The Lisp setup may involve setting a few variables and setting up the -;; search engine. You can define the variables in the server definition -;; like this : -;; (setq gnus-secondary-select-methods '( -;; (nnimap "" (nnimap-address "localhost") -;; (nnir-search-engine namazu) -;; ))) -;; The main variable to set is `nnir-search-engine'. Choose one of -;; the engines listed in `nnir-engines'. (Actually `nnir-engines' is -;; an alist, type `C-h v nnir-engines RET' for more information; this -;; includes examples for setting `nnir-search-engine', too.) - -;; The entry to searching is the single function `nnir-run-query', -;; which dispatches the search to the proper search function. The -;; argument of `nnir-run-query' is an alist with two keys: -;; 'nnir-query-spec and 'nnir-group-spec. The value for -;; 'nnir-query-spec is an alist. The only required key/value pair is -;; (query . "query") specifying the search string to pass to the query -;; engine. Individual engines may have other elements. The value of -;; 'nnir-group-spec is a list with the specification of the -;; groups/servers to search. The format of the 'nnir-group-spec is -;; (("server1" ("group11" "group12")) ("server2" ("group21" -;; "group22"))). If any of the group lists is absent then all groups -;; on that server are searched. - -;; The output of `nnir-run-query' is a vector, each element of which -;; should in turn be a three-element vector with the form: [fully -;; prefixed group-name of the article; the article number; the -;; Retrieval Status Value (RSV)] as returned from the search engine. -;; An RSV is the score assigned to the document by the search engine. -;; For Boolean search engines, the RSV is always 1000 (or 1 or 100, or -;; whatever you like). - -;; A vector of this form is used by the nnselect backend to create -;; virtual groups. So nnir-run-query is a suitable function to use in -;; nnselect groups. - -;; The default sorting order of articles in an nnselect summary buffer -;; is based on the order of the articles in the above mentioned -;; vector, so that's where you can do the sorting you'd like. Maybe -;; it would be nice to have a way of displaying the search result -;; sorted differently? - -;; So what do you need to do when you want to add another search -;; engine? You write a function that executes the query. Temporary -;; data from the search engine can be put in `nnir-tmp-buffer'. This -;; function should return the list of articles as a vector, as -;; described above. Then, you need to register this backend in -;; `nnir-engines'. Then, users can choose the backend by setting -;; `nnir-search-engine' as a server variable. - -;; If you use one of the local indices (namazu, find-grep, swish) you -;; must also set up a search engine backend. - -;; 1. Namazu -;; -;; The Namazu backend requires you to have one directory containing all -;; index files, this is controlled by the `nnir-namazu-index-directory' -;; variable. To function the `nnir-namazu-remove-prefix' variable must -;; also be correct, see the documentation for `nnir-namazu-remove-prefix' -;; above. -;; -;; It is particularly important not to pass any switches to namazu -;; that will change the output format. Good switches to use include -;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu -;; documentation for further information on valid switches. -;; -;; To index my mail with the `mknmz' program I use the following -;; configuration file: -;; -;; ,---- -;; | 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; -;; `---- -;; -;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and -;; ~/Mail/archive/, so to index them I go to the directory set in -;; `nnir-namazu-index-directory' and issue the following command. -;; -;; mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ -;; -;; For maximum searching efficiency I have a cron job set to run this -;; command every four hours. - -;; 2. find-grep -;; -;; The find-grep engine simply runs find(1) to locate eligible -;; articles and searches them with grep(1). This, of course, is much -;; slower than using a proper search engine but OTOH doesn't require -;; maintenance of an index and is still faster than using any built-in -;; means for searching. The method specification of the server to -;; search must include a directory for this engine to work (E.g., -;; `nnml-directory'). The tools must be POSIX compliant. GNU Find -;; prior to version 4.2.12 (4.2.26 on Linux due to incorrect ARG_MAX -;; handling) does not work. -;; ,---- -;; | ;; find-grep configuration for searching the Gnus Cache -;; | -;; | (nnml "cache" -;; | (nnml-get-new-mail nil) -;; | (nnir-search-engine find-grep) -;; | (nnml-directory "~/News/cache/") -;; | (nnml-active-file "~/News/cache/active")) -;; `---- - - -;;; Code: - -;;; Setup: - -(eval-when-compile (require 'cl-lib)) -(require 'gnus) - -;;; Internal Variables: - -(defvar gnus-inhibit-demon) - -(defvar nnir-search-history () - "Internal: the history for querying search options in nnir.") - -(defconst nnir-tmp-buffer " *nnir*" - "Internal: temporary buffer.") - - -;; Imap variables - -(defvar nnir-imap-search-arguments - '(("whole message" . "TEXT") - ("subject" . "SUBJECT") - ("to" . "TO") - ("from" . "FROM") - ("body" . "BODY") - ("imap" . "") - ("gmail" . "X-GM-RAW")) - "Mapping from user readable keys to IMAP search items for use in nnir.") - -(defvar nnir-imap-search-other "HEADER %S" - "The IMAP search item for anything other than `nnir-imap-search-arguments'. -By default this is the name of an email header field.") - -(defvar nnir-imap-search-argument-history () - "The history for querying search options in nnir.") - -;;; Helper macros - -(defmacro nnir-artitem-group (artitem) - "Return the group from the ARTITEM." - `(elt ,artitem 0)) - -(defmacro nnir-artitem-number (artitem) - "Return the number from the ARTITEM." - `(elt ,artitem 1)) - -(defmacro nnir-artitem-rsv (artitem) - "Return the Retrieval Status Value (RSV, score) from the ARTITEM." - `(elt ,artitem 2)) - - -;;; User Customizable Variables: - -(defgroup nnir nil - "Search groups in Gnus with assorted search engines." - :group 'gnus) - -(make-obsolete-variable 'nnir-summary-line-format "The formatting -specs previously unique to this variable may now be set in -'gnus-summary-line-format." "28.1") - -(defcustom nnir-summary-line-format nil - "The format specification of the lines in an nnir summary buffer. - -All the items from `gnus-summary-line-format' are available, along -with three items unique to nnir summary buffers: - -%Z Search retrieval score value (integer) -%G Article original full group name (string) -%g Article original short group name (string) - -If nil this will use `gnus-summary-line-format'." - :version "24.1" - :type '(choice (const :tag "gnus-summary-line-format" nil) string) - :group 'nnir) - - -(defcustom nnir-ignored-newsgroups "" - "Newsgroups to skip when searching. -Any newsgroup in the active file matching this regexp will be -skipped when searching." - :version "24.1" - :type '(regexp) - :group 'nnir) - -(defcustom nnir-imap-default-search-key "whole message" - "The default IMAP search key for an nnir search. -Must be one of the keys in `nnir-imap-search-arguments'. To use -raw imap queries by default set this to \"imap\"." - :version "24.1" - :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) - nnir-imap-search-arguments)) - :group 'nnir) - -(defcustom nnir-swish++-configuration-file - (expand-file-name "~/Mail/swish++.conf") - "Configuration file for swish++." - :type '(file) - :group 'nnir) - -(defcustom nnir-swish++-program "search" - "Name of swish++ search executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-swish++-additional-switches '() - "A list of strings, to be given as additional arguments to swish++. - -Note that this should be a list. I.e., do NOT use the following: - (setq nnir-swish++-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-swish++-additional-switches \\='(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") - "The prefix to remove from swish++ file names to get group names. -Resulting names have '/' in place of '.'. This is a regular -expression. - -This variable is very similar to `nnir-namazu-remove-prefix', except -that it is for swish++, not Namazu." - :type '(regexp) - :group 'nnir) - -;; Swish-E. -;; URL: http://swish-e.org/ -;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and -;; `nnir-swish-e-additional-switches' - -(make-obsolete-variable 'nnir-swish-e-index-file - 'nnir-swish-e-index-files "Emacs 23.1") -(defcustom nnir-swish-e-index-file - (expand-file-name "~/Mail/index.swish-e") - "Index file for swish-e. -This could be a server parameter. -It is never consulted once `nnir-swish-e-index-files', which should be -used instead, has been customized." - :type '(file) - :group 'nnir) - -(defcustom nnir-swish-e-index-files - (list nnir-swish-e-index-file) - "List of index files for swish-e. -This could be a server parameter." - :type '(repeat (file)) - :group 'nnir) - -(defcustom nnir-swish-e-program "swish-e" - "Name of swish-e search executable. -This cannot be a server parameter." - :type '(string) - :group 'nnir) - -(defcustom nnir-swish-e-additional-switches '() - "A list of strings, to be given as additional arguments to swish-e. - -Note that this should be a list. I.e., do NOT use the following: - (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-swish-e-additional-switches \\='(\"-i\" \"-w\")) - -This could be a server parameter." - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") - "The prefix to remove from swish-e file names to get group names. -Resulting names have '/' in place of '.'. This is a regular -expression. - -This variable is very similar to `nnir-namazu-remove-prefix', except -that it is for swish-e, not Namazu. - -This could be a server parameter." - :type '(regexp) - :group 'nnir) - -;; HyREX engine, see - -(defcustom nnir-hyrex-program "nnir-search" - "Name of the nnir-search executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-hyrex-additional-switches '() - "A list of strings, to be given as additional arguments for nnir-search. -Note that this should be a list. I.e., do NOT use the following: - (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! -Instead, use this: - (setq nnir-hyrex-additional-switches \\='(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-hyrex-index-directory (getenv "HOME") - "Index directory for HyREX." - :type '(directory) - :group 'nnir) - -(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") - "The prefix to remove from HyREX file names to get group names. -Resulting names have '/' in place of '.'. - -For example, suppose that HyREX returns file names such as -\"/home/john/Mail/mail/misc/42\". For this example, use the following -setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\") -Note the trailing slash. Removing this prefix gives \"mail/misc/42\". -`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to -arrive at the correct group name, \"mail.misc\"." - :type '(directory) - :group 'nnir) - -;; Namazu engine, see - -(defcustom nnir-namazu-program "namazu" - "Name of Namazu search executable." - :type '(string) - :group 'nnir) - -(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") - "Index directory for Namazu." - :type '(directory) - :group 'nnir) - -(defcustom nnir-namazu-additional-switches '() - "A list of strings, to be given as additional arguments to namazu. -The switches `-q', `-a', and `-s' are always used, very few other -switches make any sense in this context. - -Note that this should be a list. I.e., do NOT use the following: - (setq nnir-namazu-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-namazu-additional-switches \\='(\"-i\" \"-w\"))" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") - "The prefix to remove from Namazu file names to get group names. -Resulting names have '/' in place 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 nnir-namazu-remove-prefix \"/home/john/Mail/\") -Note the trailing slash. Removing this prefix gives \"mail/misc/42\". -`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to -arrive at the correct group name, \"mail.misc\"." - :type '(directory) - :group 'nnir) - -(defcustom nnir-notmuch-program "notmuch" - "Name of notmuch search executable." - :version "24.1" - :type '(string) - :group 'nnir) - -(defcustom nnir-notmuch-additional-switches '() - "A list of strings, to be given as additional arguments to notmuch. - -Note that this should be a list. I.e., do NOT use the following: - (setq nnir-notmuch-additional-switches \"-i -w\") ; wrong -Instead, use this: - (setq nnir-notmuch-additional-switches \\='(\"-i\" \"-w\"))" - :version "24.1" - :type '(repeat (string)) - :group 'nnir) - -(defcustom nnir-notmuch-remove-prefix - (regexp-quote (or (getenv "MAILDIR") (expand-file-name "~/Mail"))) - "The prefix to remove from notmuch file names to get group names. -Resulting names have '/' in place of '.'. This is a regular -expression. - -This variable is very similar to `nnir-namazu-remove-prefix', except -that it is for notmuch, not Namazu." - :version "27.1" - :type '(regexp) - :group 'nnir) - -(defcustom nnir-notmuch-filter-group-names-function nil - "Whether and how to use Gnus group names as \"path:\" search terms. -When nil, the groups being searched in are not used as notmuch -:path search terms. It's still possible to use \"path:\" terms -manually within the search query, however. - -When a function, map this function over all the group names. To -use the group names unchanged, set to (lambda (g) g). Multiple -transforms (for instance, converting \".\" to \"/\") can be added -like so: - -\(add-function :filter-return - nnir-notmuch-filter-group-names-function - (lambda (g) (replace-regexp-in-string \"\\\\.\" \"/\" g)))" - :version "27.1" - :type '(choice function - (const :tag "No" nil))) - -;;; Developer Extension Variable: - -(defvar nnir-engines - `((imap nnir-run-imap - ((criteria - "Imap Search in" ; Prompt - ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing - nil ; allow any user input - nil ; initial value - nnir-imap-search-argument-history ; the history to use - ,nnir-imap-default-search-key ; default - ))) - (swish++ nnir-run-swish++ - ((swish++-group . "Swish++ Group spec (regexp): "))) - (swish-e nnir-run-swish-e - ((swish-e-group . "Swish-e Group spec (regexp): "))) - (namazu nnir-run-namazu - ()) - (notmuch nnir-run-notmuch - ()) - (hyrex nnir-run-hyrex - ((hyrex-group . "Hyrex Group spec (regexp): "))) - (find-grep nnir-run-find-grep - ((grep-options . "Grep options: ")))) - "Alist of supported search engines. -Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). -ENGINE is a symbol designating the searching engine. FUNCTION is also -a symbol, giving the function that does the search. The third element -ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, -the FUNCTION will issue a query for each of the PARAMs, using PROMPT. - -The value of `nnir-search-engine' must be one of the ENGINE symbols. -For example, for searching a server using namazu include - (nnir-search-engine namazu) -in the server definition. Note that you have to set additional -variables for most backends. For example, the `namazu' backend -needs the variables `nnir-namazu-program', -`nnir-namazu-index-directory' and `nnir-namazu-remove-prefix'. - -Add an entry here when adding a new search engine.") - -(defcustom nnir-method-default-engines '((nnimap . imap)) - "Alist of default search engines keyed by server method." - :version "27.1" - :group 'nnir - :type `(repeat (cons (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 (elem) (list 'const (car elem))) - nnir-engines))))) - - -(defmacro nnir-add-result (dirnam artno score prefix server artlist) - "Construct a result vector and add it to ARTLIST. -DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to -`nnir-compose-result' to make the vector. Only add the result if -non-nil." - `(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server))) - (when (not (null result)) - (push result ,artlist)))) - -(autoload 'nnmaildir-base-name-to-article-number "nnmaildir") - -;; Helper function currently used by the Swish++ and Namazu backends; -;; perhaps useful for other backends as well -(defun nnir-compose-result (dirnam article score prefix server) - "Construct a result vector. -The DIRNAM, ARTICLE, SCORE, PREFIX, and SERVER are used to -construct the vector entries." - ;; remove nnir-*-remove-prefix from beginning of dirnam filename - (when (string-match (concat "^" prefix) dirnam) - (setq dirnam (replace-match "" t t dirnam))) - - (when (file-readable-p (concat prefix dirnam article)) - ;; remove trailing slash and, for nnmaildir, cur/new/tmp - (setq dirnam - (substring dirnam 0 - (if (string-match "\\`nnmaildir:" (gnus-group-server server)) - -5 -1))) - - ;; Set group to dirnam without any leading dots or slashes, - ;; and with all subsequent slashes replaced by dots - (let ((group (replace-regexp-in-string - "[/\\]" "." - (replace-regexp-in-string "^[./\\]" "" dirnam nil t) - nil t))) - - (vector (gnus-group-full-name group server) - (if (string-match "\\`nnmaildir:" (gnus-group-server server)) - (nnmaildir-base-name-to-article-number - (substring article 0 (string-match ":" article)) - group nil) - (string-to-number article)) - (string-to-number score))))) - -;;; Search Engine Interfaces: - -(autoload 'gnus-server-get-active "gnus-int") -(autoload 'nnimap-change-group "nnimap") -(declare-function nnimap-buffer "nnimap" ()) -(declare-function nnimap-command "nnimap" (&rest args)) - -;; imap interface -(defun nnir-run-imap (query srv &optional groups) - "Run the QUERY search against an IMAP back-end server SRV. -Search GROUPS, or all active groups on SRV if GROUPS is nil. -This uses a custom query language parser; see -`nnir-imap-make-query' for details on the language and supported -extensions." - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (server (cadr (gnus-server-to-method srv))) - (criteria (or (cdr (assq 'criteria query)) - (cdr (assoc nnir-imap-default-search-key - nnir-imap-search-arguments)))) - (gnus-inhibit-demon t) - (groups - (or groups (gnus-server-get-active srv nnir-ignored-newsgroups)))) - (message "Opening server %s" server) - (apply - 'vconcat - (catch 'found - (mapcar - #'(lambda (group) - (let (artlist) - (condition-case () - (when (nnimap-change-group - (gnus-group-short-name group) server) - (with-current-buffer (nnimap-buffer) - (message "Searching %s..." group) - (let ((arts 0) - (result (nnimap-command "UID SEARCH %s" - (if (string= criteria "") - qstring - (nnir-imap-make-query - criteria qstring))))) - (mapc - (lambda (artnum) - (let ((artn (string-to-number artnum))) - (when (> artn 0) - (push (vector group artn 100) - artlist) - (when (assq 'shortcut query) - (throw 'found (list artlist))) - (setq arts (1+ arts))))) - (and (car result) - (cdr (assoc "SEARCH" (cdr result))))) - (message "Searching %s... %d matches" group arts))) - (message "Searching %s...done" group)) - (quit nil)) - (nreverse artlist))) - groups)))))) - -(defun nnir-imap-make-query (criteria qstring) - "Make an IMAP search expression from QSTRING and CRITERIA. - -This implements a little language designed to return the expected -results to an arbitrary query string to the end user. - -The search is always case-insensitive, as defined by RFC2060, and -supports the following features (inspired by the Google search input -language): - -Automatic \"and\" queries - If you specify multiple words then they will be treated as an - \"and\" expression intended to match all components. - -Phrase searches - If you wrap your query in double-quotes then it will be treated - as a literal string. - -Negative terms - If you precede a term with \"-\" then it will negate that. - -\"OR\" queries - If you include an upper-case \"OR\" in your search it will cause - the term before it and the term after it to be treated as - alternatives. - -In the future the following will be added to the language: - * support for date matches - * support for location of text matching within the query - * from/to/etc headers - * additional search terms - * flag based searching - * anything else that the RFC supports, basically." - ;; Walk through the query and turn it into an IMAP query string. - (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring))) - - -(defun nnir-imap-query-to-imap (criteria query) - "Turn an s-expression format QUERY with CRITERIA into IMAP." - (mapconcat - ;; Turn the expressions into IMAP text - (lambda (item) - (nnir-imap-expr-to-imap criteria item)) - ;; The query, already in s-expr format. - query - ;; Append a space between each expression - " ")) - - -(defun nnir-imap-expr-to-imap (criteria expr) - "Convert EXPR into an IMAP search expression on CRITERIA." - ;; What sort of expression is this, eh? - (cond - ;; Simple string term - ((stringp expr) - (format "%s %S" criteria expr)) - ;; Trivial term: and - ((eq expr 'and) nil) - ;; Composite term: or expression - ((eq (car-safe expr) 'or) - (format "OR %s %s" - (nnir-imap-expr-to-imap criteria (nth 1 expr)) - (nnir-imap-expr-to-imap criteria (nth 2 expr)))) - ;; Composite term: just the fax, mam - ((eq (car-safe expr) 'not) - (format "NOT (%s)" (nnir-imap-query-to-imap criteria (cdr expr)))) - ;; Composite term: just expand it all. - ((consp expr) - (format "(%s)" (nnir-imap-query-to-imap criteria expr))) - ;; Complex value, give up for now. - (t (error "Unhandled input: %S" expr)))) - - -(defun nnir-imap-parse-query (string) - "Turn STRING into an s-expression query. -STRING is based on the IMAP query language as defined in -`nnir-imap-make-query'. - -This involves turning individual tokens into higher level terms -that the search language can then understand and use." - (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 (nnir-imap-end-of-input)) - (push (nnir-imap-next-expr) out)) - (reverse out)))) - - -(defun nnir-imap-next-expr (&optional count) - "Return the next (COUNT) expression from the current buffer." - (let ((term (nnir-imap-next-term count)) - (next (nnir-imap-peek-symbol))) - ;; Are we looking at an 'or' expression? - (cond - ;; Handle 'expr or expr' - ((eq next 'or) - (list 'or term (nnir-imap-next-expr 2))) - ;; Anything else - (t term)))) - - -(defun nnir-imap-next-term (&optional count) - "Return the next (COUNT) term from the current buffer." - (let ((term (nnir-imap-next-symbol count))) - ;; What sort of term is this? - (cond - ;; and -- just ignore it - ((eq term 'and) 'and) - ;; negated term - ((eq term 'not) (list 'not (nnir-imap-next-expr))) - ;; generic term - (t term)))) - - -(defun nnir-imap-peek-symbol () - "Return the next symbol from the current buffer, but don't consume it." - (save-excursion - (nnir-imap-next-symbol))) - -(defun nnir-imap-next-symbol (&optional count) - "Return the next (COUNT) symbol from the current buffer. -Return 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)) - (nnir-imap-next-symbol (1- count))) - (let ((case-fold-search t)) - ;; end of input stream? - (unless (nnir-imap-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) - ;; quoted string - ((looking-at "\"") (nnir-imap-delimited-string "\"")) - ;; list expression -- we parse the content and return this as a list. - ((looking-at "(") - (nnir-imap-parse-query (nnir-imap-delimited-string ")"))) - ;; 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) - ;; Simple, boring keyword - (t (let ((start (point)) - (end (if (search-forward-regexp "[[:blank:]]" nil t) - (prog1 - (match-beginning 0) - ;; unskip if we hit a non-blank terminal character. - (when (string-match "[^[:blank:]]" (match-string 0)) - (backward-char 1))) - (goto-char (point-max))))) - (buffer-substring start end))))))) - -(defun nnir-imap-delimited-string (delimiter) - "Return a string delimited by DELIMITER from the current buffer." - (let ((start (point)) end) - (forward-char 1) ; skip the first delimiter. - (while (not end) - (unless (search-forward delimiter nil t) - (error "Unmatched delimited input with %s in query" delimiter)) - (let ((here (point))) - (unless (equal (buffer-substring (- here 2) (- here 1)) "\\") - (setq end (point))))) - (buffer-substring (1+ start) (1- end)))) - -(defun nnir-imap-end-of-input () - "Are we at the end of input?" - (skip-chars-forward "[:blank:]") - (looking-at "$")) - - -;; Swish++ interface. -;; -cc- Todo -;; Search by -;; - group -;; Sort by -;; - rank (default) -;; - article number -;; - file size -;; - group -(defun nnir-run-swish++ (query server &optional _group) - "Run QUERY on SERVER against swish++. -Returns a vector of (group name, file name) pairs (also vectors, -actually). - -Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on -Windows NT 4.0." - - ;; (when group - ;; (error "The swish++ backend cannot search specific groups")) - - (save-excursion - (let ( (qstring (cdr (assq 'query query))) - (groupspec (cdr (assq 'swish++-group query))) - (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) - artlist - ;; nnml-use-compressed-files might be any string, but probably this - ;; is sufficient. Note that we can't only use the value of - ;; nnml-use-compressed-files because old articles might have been - ;; saved with a different value. - (article-pattern (if (string-match "\\`nnmaildir:" - (gnus-group-server server)) - ":[0-9]+" - "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) - score artno dirnam filenam) - - (when (equal "" qstring) - (error "swish++: You didn't enter anything")) - - (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - - (if groupspec - (message "Doing swish++ query %s on %s..." qstring groupspec) - (message "Doing swish++ query %s..." qstring)) - - (let* ((cp-list `( ,nnir-swish++-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server) - ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server) - ,qstring ; the query, in swish++ format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-swish++-program - (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? - (apply #'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) - ;; swish++ failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; The results are output in the format of: - ;; V 4.7 Linux - ;; rank relative-path-name file-size file-title - ;; V 5.0b2: - ;; rank relative-path-name file-size topic?? - ;; where rank is an integer from 1 to 100. - (goto-char (point-min)) - (while (re-search-forward - "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t) - (setq score (match-string 1) - filenam (match-string 2) - artno (file-name-nondirectory filenam) - dirnam (file-name-directory filenam)) - - ;; don't match directories - (when (string-match article-pattern artno) - (when (not (null dirnam)) - - ;; maybe limit results to matching groups. - (when (or (not groupspec) - (string-match groupspec dirnam)) - (nnir-add-result dirnam artno score prefix server artlist))))) - - (message "Massaging swish++ output...done") - - ;; Sort by score - (apply #'vector - (sort artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; Swish-E interface. -(defun nnir-run-swish-e (query server &optional _group) - "Run given QUERY on SERVER against swish-e. -Returns a vector of (group name, file name) pairs (also vectors, -actually). - -Tested with swish-e-2.0.1 on Windows NT 4.0." - - ;; swish-e crashes with empty parameter to "-w" on commandline... - ;; (when group - ;; (error "The swish-e backend cannot search specific groups")) - - (save-excursion - (let ((qstring (cdr (assq 'query query))) - (prefix - (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server) - (error "Missing parameter `nnir-swish-e-remove-prefix'"))) - artlist score artno dirnam group ) - - (when (equal "" qstring) - (error "swish-e: You didn't enter anything")) - - (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - - (message "Doing swish-e query %s..." query) - (let* ((index-files - (or (nnir-read-server-parm - 'nnir-swish-e-index-files server) - (error "Missing parameter `nnir-swish-e-index-files'"))) - (additional-switches - (nnir-read-server-parm - 'nnir-swish-e-additional-switches server)) - (cp-list `(,nnir-swish-e-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-f" ,@index-files - ,@additional-switches - "-w" - ,qstring ; the query, in swish-e format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-swish-e-program - (mapconcat #'identity (nthcdr 4 cp-list) " ")) - (apply #'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) - ;; swish-e failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; The results are output in the format of: - ;; rank path-name file-title file-size - (goto-char (point-min)) - (while (re-search-forward - "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t) - (setq score (match-string 1) - artno (match-string 3) - dirnam (file-name-directory (match-string 2))) - - ;; don't match directories - (when (string-match "^[0-9]+$" artno) - (when (not (null dirnam)) - - ;; remove nnir-swish-e-remove-prefix from beginning of dirname - (when (string-match (concat "^" prefix) dirnam) - (setq dirnam (replace-match "" t t dirnam))) - - (setq dirnam (substring dirnam 0 -1)) - ;; eliminate all ".", "/", "\" from beginning. Always matches. - (string-match "^[./\\]*\\(.*\\)$" dirnam) - ;; "/" -> "." - (setq group (replace-regexp-in-string - "/" "." (match-string 1 dirnam))) - ;; Windows "\\" -> "." - (setq group (replace-regexp-in-string "\\\\" "." group)) - - (push (vector (gnus-group-full-name group server) - (string-to-number artno) - (string-to-number score)) - artlist)))) - - (message "Massaging swish-e output...done") - - ;; Sort by score - (apply #'vector - (sort artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -;; HyREX interface -(defun nnir-run-hyrex (query server &optional group) - "Run given QUERY with GROUP on SERVER against hyrex." - (save-excursion - (let ((artlist nil) - (groupspec (cdr (assq 'hyrex-group query))) - (qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) - score artno dirnam) - (when (and (not groupspec) group) - (setq groupspec - (regexp-opt - (mapcar (lambda (x) (gnus-group-real-name x)) group)))) - (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (message "Doing hyrex-search query %s..." query) - (let* ((cp-list - `( ,nnir-hyrex-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory - ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server) - ,qstring ; the query, in hyrex-search format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-hyrex-program - (mapconcat #'identity (nthcdr 4 cp-list) " ")) - (apply #'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) - ;; nnir-search failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) ;; FIXME: Don't clear buffer ! - (message "Doing hyrex-search query \"%s\"...done" qstring) - (sit-for 0) - ;; nnir-search returns: - ;; for nnml/nnfolder: "filename mailid weight" - ;; for nnimap: "group mailid weight" - (goto-char (point-min)) - (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") - ;; HyREX doesn't search directly in groups -- so filter out here. - (when groupspec - (keep-lines groupspec)) - ;; extract data from result lines - (goto-char (point-min)) - (while (re-search-forward - "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t) - (setq dirnam (match-string 1) - artno (match-string 2) - score (match-string 3)) - (when (string-match prefix dirnam) - (setq dirnam (replace-match "" t t dirnam))) - (push (vector (gnus-group-full-name - (replace-regexp-in-string "/" "." dirnam) server) - (string-to-number artno) - (string-to-number score)) - artlist)) - (message "Massaging hyrex-search output...done.") - (apply #'vector - (sort artlist - (function (lambda (x y) - (if (string-lessp (nnir-artitem-group x) - (nnir-artitem-group y)) - t - (< (nnir-artitem-number x) - (nnir-artitem-number y))))))) - ))) - -;; Namazu interface -(defun nnir-run-namazu (query server &optional _group) - "Run QUERY on SERVER against Namazu. -Returns a vector of (group name, file name) pairs (also vectors, -actually). - -Tested with Namazu 2.0.6 on a GNU/Linux system." - ;; (when group - ;; (error "The Namazu backend cannot search specific groups")) - (save-excursion - (let ((article-pattern (if (string-match "\\`nnmaildir:" - (gnus-group-server server)) - ":[0-9]+" - "^[0-9]+$")) - artlist - (qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server)) - score group article - (process-environment (copy-sequence process-environment))) - (setenv "LC_MESSAGES" "C") - (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - (let* ((cp-list - `( ,nnir-namazu-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "-q" ; don't be verbose - "-a" ; show all matches - "-s" ; use short format - ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server) - ,qstring ; the query, in namazu format - ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory - )) - (exitstatus - (progn - (message "%s args: %s" nnir-namazu-program - (mapconcat #'identity (nthcdr 4 cp-list) " ")) - (apply #'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) - ;; Namazu failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; Namazu output looks something like this: - ;; 2. Re: Gnus agent expire broken (score: 55) - ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes) - - (goto-char (point-min)) - (while (re-search-forward - "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" - nil t) - (setq score (match-string 3) - group (file-name-directory (match-string 4)) - article (file-name-nondirectory (match-string 4))) - - ;; make sure article and group is sane - (when (and (string-match article-pattern article) - (not (null group))) - (nnir-add-result group article score prefix server artlist))) - - ;; sort artlist by score - (apply #'vector - (sort artlist - (function (lambda (x y) - (> (nnir-artitem-rsv x) - (nnir-artitem-rsv y))))))))) - -(defun nnir-run-notmuch (query server &optional groups) - "Run QUERY with GROUPS from SERVER against notmuch. -Returns a vector of (group name, file name) pairs (also vectors, -actually). If GROUPS is a list of group names, use them to -construct path: search terms (see the variable -`nnir-notmuch-filter-group-names-function')." - - (save-excursion - (let* ((qstring (cdr (assq 'query query))) - (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) - artlist - (article-pattern (if (string-match "\\`nnmaildir:" - (gnus-group-server server)) - ":[0-9]+" - "^[0-9]+$")) - (groups (when nnir-notmuch-filter-group-names-function - (delq nil - (mapcar nnir-notmuch-filter-group-names-function - (mapcar #'gnus-group-short-name groups))))) - (pathquery (when groups - (concat " (" - (mapconcat (lambda (g) - (format "path:%s" g)) - groups " or") - ")"))) - artno dirnam filenam) - - (when (equal "" qstring) - (error "notmuch: You didn't enter anything")) - - (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) - (erase-buffer) - - (if groups - (message "Doing notmuch query %s on %s..." - qstring (mapconcat #'identity groups " ")) - (message "Doing notmuch query %s..." qstring)) - - (when groups - (setq qstring (concat qstring pathquery))) - - (let* ((cp-list `( ,nnir-notmuch-program - nil ; input from /dev/null - t ; output - nil ; don't redisplay - "search" - "--format=text" - "--output=files" - ,@(nnir-read-server-parm 'nnir-notmuch-additional-switches server) - ,qstring ; the query, in notmuch format - )) - (exitstatus - (progn - (message "%s args: %s" nnir-notmuch-program - (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? - (apply #'call-process cp-list)))) - (unless (or (null exitstatus) - (zerop exitstatus)) - (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus) - ;; notmuch failure reason is in this buffer, show it if - ;; the user wants it. - (when (> gnus-verbose 6) - (display-buffer nnir-tmp-buffer)))) - - ;; The results are output in the format of: - ;; absolute-path-name - (goto-char (point-min)) - (while (not (eobp)) - (setq filenam (buffer-substring-no-properties (line-beginning-position) - (line-end-position)) - artno (file-name-nondirectory filenam) - dirnam (file-name-directory filenam)) - (forward-line 1) - - ;; don't match directories - (when (string-match article-pattern artno) - (when (not (null dirnam)) - - (nnir-add-result dirnam artno "" prefix server artlist)))) - - (message "Massaging notmuch output...done") - - artlist))) - -(defun nnir-run-find-grep (query server &optional grouplist) - "Run find and grep to QUERY GROUPLIST on SERVER for matching articles." - (let* ((method (gnus-server-to-method server)) - (sym (intern - (concat (symbol-name (car method)) "-directory"))) - (directory (cadr (assoc sym (cddr method)))) - (regexp (cdr (assoc 'query query))) - (grep-options (cdr (assoc 'grep-options query))) - (grouplist - (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups)))) - (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 (gnus-get-buffer-create nnir-tmp-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" - "grep" - `("-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 - ;; Replace cl-func: - ;; (subseq path 0 -1) - (let ((end (1- (length path))) - res) - (while - (>= (setq end (1- end)) 0) - (push (pop path) res)) - (nreverse res)) - "."))) - (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)) - -;;; Util Code: - - -(defun nnir-read-parms (nnir-search-engine) - "Read additional search parameters for NNIR-SEARCH-ENGINE. -Parameters are according to `nnir-engines'." - (let ((parmspec (nth 2 (assoc nnir-search-engine nnir-engines)))) - (mapcar #'nnir-read-parm parmspec))) - -(defun nnir-read-parm (parmspec) - "Read a single search parameter. -PARMSPEC is a cons cell, the car is a symbol, the cdr is a prompt." - (let ((sym (car parmspec)) - (prompt (cdr parmspec))) - (if (listp prompt) - (let* ((result (apply #'gnus-completing-read prompt)) - (mapping (or (assoc result nnir-imap-search-arguments) - (cons nil nnir-imap-search-other)))) - (cons sym (format (cdr mapping) result))) - (cons sym (read-string prompt))))) - -(defun nnir-run-query (specs) - "Invoke search engine appropriate for SPECS (see `nnir-engines')." - (apply #'vconcat - (mapcar - (lambda (x) - (let* ((server (car x)) - (search-engine (nnir-server-to-search-engine server)) - (search-func (cadr (assoc search-engine nnir-engines)))) - (and search-func - (funcall search-func (cdr (assq 'nnir-query-spec specs)) - server (cdr x))))) - (cdr (assq 'nnir-group-spec specs))))) - -(defun nnir-server-to-search-engine (server) - "Find search engine for SERVER." - (or (nnir-read-server-parm 'nnir-search-engine server t) - (cdr (assoc (car (gnus-server-to-method server)) - nnir-method-default-engines)))) - -(defun nnir-read-server-parm (key server &optional not-global) - "Return the parameter value corresponding to KEY for SERVER. -If no server-specific value is found consult the global -environment unless NOT-GLOBAL is non-nil." - (let ((method (gnus-server-to-method server))) - (cond ((and method (assq key (cddr method))) - (nth 1 (assq key (cddr method)))) - ((and (not not-global) (boundp key)) (symbol-value key)) - (t nil)))) - -(autoload 'gnus-group-topic-name "gnus-topic" nil nil) -(defvar gnus-group-marked) -(defvar gnus-topic-alist) - -(make-obsolete 'nnir-make-specs "This function should no longer -be used." "28.1") - -(defun nnir-make-specs (nnir-extra-parms &optional specs) - "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS. -Query for the specs, or use SPECS." - (let* ((group-spec - (or (cdr (assq 'nnir-group-spec specs)) - (if (gnus-server-server-name) - (list (list (gnus-server-server-name))) - (seq-group-by - (lambda (elt) (gnus-group-server elt)) - (or gnus-group-marked - (if (gnus-group-group-name) - (list (gnus-group-group-name)) - (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)))))) - (list (cons 'nnir-query-spec query-spec) - (cons 'nnir-group-spec group-spec)))) - -(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1") - -;; The end. -(provide 'nnir) - -;;; nnir.el ends here diff --git a/lisp/obsolete/nnir.el b/lisp/obsolete/nnir.el new file mode 100644 index 00000000000..20f82e5cbdf --- /dev/null +++ b/lisp/obsolete/nnir.el @@ -0,0 +1,1377 @@ +;;; nnir.el --- Search mail with various search engines -*- lexical-binding:t -*- + +;; Copyright (C) 1998-2020 Free Software Foundation, Inc. + +;; Author: Kai Großjohann +;; Swish-e and Swish++ backends by: +;; Christoph Conrad . +;; IMAP backend by: Simon Josefsson . +;; IMAP search by: Torsten Hilbrich gmx.net> +;; IMAP search improved by Daniel Pittman . +;; nnmaildir support for Swish++ and Namazu backends by: +;; Justus Piater Piater.name> +;; Mostly rewritten by Andrew Cohen from 2010 +;; Keywords: news mail searching ir + +;; This file is part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; What does it do? Well, it searches your mail using some search +;; engine (imap, namazu, swish-e, gmane and others -- see later). + +;; The Lisp setup may involve setting a few variables and setting up the +;; search engine. You can define the variables in the server definition +;; like this : +;; (setq gnus-secondary-select-methods '( +;; (nnimap "" (nnimap-address "localhost") +;; (nnir-search-engine namazu) +;; ))) +;; The main variable to set is `nnir-search-engine'. Choose one of +;; the engines listed in `nnir-engines'. (Actually `nnir-engines' is +;; an alist, type `C-h v nnir-engines RET' for more information; this +;; includes examples for setting `nnir-search-engine', too.) + +;; The entry to searching is the single function `nnir-run-query', +;; which dispatches the search to the proper search function. The +;; argument of `nnir-run-query' is an alist with two keys: +;; 'nnir-query-spec and 'nnir-group-spec. The value for +;; 'nnir-query-spec is an alist. The only required key/value pair is +;; (query . "query") specifying the search string to pass to the query +;; engine. Individual engines may have other elements. The value of +;; 'nnir-group-spec is a list with the specification of the +;; groups/servers to search. The format of the 'nnir-group-spec is +;; (("server1" ("group11" "group12")) ("server2" ("group21" +;; "group22"))). If any of the group lists is absent then all groups +;; on that server are searched. + +;; The output of `nnir-run-query' is a vector, each element of which +;; should in turn be a three-element vector with the form: [fully +;; prefixed group-name of the article; the article number; the +;; Retrieval Status Value (RSV)] as returned from the search engine. +;; An RSV is the score assigned to the document by the search engine. +;; For Boolean search engines, the RSV is always 1000 (or 1 or 100, or +;; whatever you like). + +;; A vector of this form is used by the nnselect backend to create +;; virtual groups. So nnir-run-query is a suitable function to use in +;; nnselect groups. + +;; The default sorting order of articles in an nnselect summary buffer +;; is based on the order of the articles in the above mentioned +;; vector, so that's where you can do the sorting you'd like. Maybe +;; it would be nice to have a way of displaying the search result +;; sorted differently? + +;; So what do you need to do when you want to add another search +;; engine? You write a function that executes the query. Temporary +;; data from the search engine can be put in `nnir-tmp-buffer'. This +;; function should return the list of articles as a vector, as +;; described above. Then, you need to register this backend in +;; `nnir-engines'. Then, users can choose the backend by setting +;; `nnir-search-engine' as a server variable. + +;; If you use one of the local indices (namazu, find-grep, swish) you +;; must also set up a search engine backend. + +;; 1. Namazu +;; +;; The Namazu backend requires you to have one directory containing all +;; index files, this is controlled by the `nnir-namazu-index-directory' +;; variable. To function the `nnir-namazu-remove-prefix' variable must +;; also be correct, see the documentation for `nnir-namazu-remove-prefix' +;; above. +;; +;; It is particularly important not to pass any switches to namazu +;; that will change the output format. Good switches to use include +;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu +;; documentation for further information on valid switches. +;; +;; To index my mail with the `mknmz' program I use the following +;; configuration file: +;; +;; ,---- +;; | 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; +;; `---- +;; +;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and +;; ~/Mail/archive/, so to index them I go to the directory set in +;; `nnir-namazu-index-directory' and issue the following command. +;; +;; mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ +;; +;; For maximum searching efficiency I have a cron job set to run this +;; command every four hours. + +;; 2. find-grep +;; +;; The find-grep engine simply runs find(1) to locate eligible +;; articles and searches them with grep(1). This, of course, is much +;; slower than using a proper search engine but OTOH doesn't require +;; maintenance of an index and is still faster than using any built-in +;; means for searching. The method specification of the server to +;; search must include a directory for this engine to work (E.g., +;; `nnml-directory'). The tools must be POSIX compliant. GNU Find +;; prior to version 4.2.12 (4.2.26 on Linux due to incorrect ARG_MAX +;; handling) does not work. +;; ,---- +;; | ;; find-grep configuration for searching the Gnus Cache +;; | +;; | (nnml "cache" +;; | (nnml-get-new-mail nil) +;; | (nnir-search-engine find-grep) +;; | (nnml-directory "~/News/cache/") +;; | (nnml-active-file "~/News/cache/active")) +;; `---- + + +;;; Code: + +;;; Setup: + +(eval-when-compile (require 'cl-lib)) +(require 'gnus) + +;;; Internal Variables: + +(defvar gnus-inhibit-demon) + +(defvar nnir-search-history () + "Internal: the history for querying search options in nnir.") + +(defconst nnir-tmp-buffer " *nnir*" + "Internal: temporary buffer.") + + +;; Imap variables + +(defvar nnir-imap-search-arguments + '(("whole message" . "TEXT") + ("subject" . "SUBJECT") + ("to" . "TO") + ("from" . "FROM") + ("body" . "BODY") + ("imap" . "") + ("gmail" . "X-GM-RAW")) + "Mapping from user readable keys to IMAP search items for use in nnir.") + +(defvar nnir-imap-search-other "HEADER %S" + "The IMAP search item for anything other than `nnir-imap-search-arguments'. +By default this is the name of an email header field.") + +(defvar nnir-imap-search-argument-history () + "The history for querying search options in nnir.") + +;;; Helper macros + +(defmacro nnir-artitem-group (artitem) + "Return the group from the ARTITEM." + `(elt ,artitem 0)) + +(defmacro nnir-artitem-number (artitem) + "Return the number from the ARTITEM." + `(elt ,artitem 1)) + +(defmacro nnir-artitem-rsv (artitem) + "Return the Retrieval Status Value (RSV, score) from the ARTITEM." + `(elt ,artitem 2)) + + +;;; User Customizable Variables: + +(defgroup nnir nil + "Search groups in Gnus with assorted search engines." + :group 'gnus) + +(make-obsolete-variable 'nnir-summary-line-format "The formatting +specs previously unique to this variable may now be set in +'gnus-summary-line-format." "28.1") + +(defcustom nnir-summary-line-format nil + "The format specification of the lines in an nnir summary buffer. + +All the items from `gnus-summary-line-format' are available, along +with three items unique to nnir summary buffers: + +%Z Search retrieval score value (integer) +%G Article original full group name (string) +%g Article original short group name (string) + +If nil this will use `gnus-summary-line-format'." + :version "24.1" + :type '(choice (const :tag "gnus-summary-line-format" nil) string) + :group 'nnir) + + +(defcustom nnir-ignored-newsgroups "" + "Newsgroups to skip when searching. +Any newsgroup in the active file matching this regexp will be +skipped when searching." + :version "24.1" + :type '(regexp) + :group 'nnir) + +(defcustom nnir-imap-default-search-key "whole message" + "The default IMAP search key for an nnir search. +Must be one of the keys in `nnir-imap-search-arguments'. To use +raw imap queries by default set this to \"imap\"." + :version "24.1" + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-imap-search-arguments)) + :group 'nnir) + +(defcustom nnir-swish++-configuration-file + (expand-file-name "~/Mail/swish++.conf") + "Configuration file for swish++." + :type '(file) + :group 'nnir) + +(defcustom nnir-swish++-program "search" + "Name of swish++ search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-swish++-additional-switches '() + "A list of strings, to be given as additional arguments to swish++. + +Note that this should be a list. I.e., do NOT use the following: + (setq nnir-swish++-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-swish++-additional-switches \\='(\"-i\" \"-w\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") + "The prefix to remove from swish++ file names to get group names. +Resulting names have '/' in place of '.'. This is a regular +expression. + +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish++, not Namazu." + :type '(regexp) + :group 'nnir) + +;; Swish-E. +;; URL: http://swish-e.org/ +;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and +;; `nnir-swish-e-additional-switches' + +(make-obsolete-variable 'nnir-swish-e-index-file + 'nnir-swish-e-index-files "Emacs 23.1") +(defcustom nnir-swish-e-index-file + (expand-file-name "~/Mail/index.swish-e") + "Index file for swish-e. +This could be a server parameter. +It is never consulted once `nnir-swish-e-index-files', which should be +used instead, has been customized." + :type '(file) + :group 'nnir) + +(defcustom nnir-swish-e-index-files + (list nnir-swish-e-index-file) + "List of index files for swish-e. +This could be a server parameter." + :type '(repeat (file)) + :group 'nnir) + +(defcustom nnir-swish-e-program "swish-e" + "Name of swish-e search executable. +This cannot be a server parameter." + :type '(string) + :group 'nnir) + +(defcustom nnir-swish-e-additional-switches '() + "A list of strings, to be given as additional arguments to swish-e. + +Note that this should be a list. I.e., do NOT use the following: + (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-swish-e-additional-switches \\='(\"-i\" \"-w\")) + +This could be a server parameter." + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") + "The prefix to remove from swish-e file names to get group names. +Resulting names have '/' in place of '.'. This is a regular +expression. + +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for swish-e, not Namazu. + +This could be a server parameter." + :type '(regexp) + :group 'nnir) + +;; HyREX engine, see + +(defcustom nnir-hyrex-program "nnir-search" + "Name of the nnir-search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-hyrex-additional-switches '() + "A list of strings, to be given as additional arguments for nnir-search. +Note that this should be a list. I.e., do NOT use the following: + (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! +Instead, use this: + (setq nnir-hyrex-additional-switches \\='(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-hyrex-index-directory (getenv "HOME") + "Index directory for HyREX." + :type '(directory) + :group 'nnir) + +(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") + "The prefix to remove from HyREX file names to get group names. +Resulting names have '/' in place of '.'. + +For example, suppose that HyREX returns file names such as +\"/home/john/Mail/mail/misc/42\". For this example, use the following +setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." + :type '(directory) + :group 'nnir) + +;; Namazu engine, see + +(defcustom nnir-namazu-program "namazu" + "Name of Namazu search executable." + :type '(string) + :group 'nnir) + +(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") + "Index directory for Namazu." + :type '(directory) + :group 'nnir) + +(defcustom nnir-namazu-additional-switches '() + "A list of strings, to be given as additional arguments to namazu. +The switches `-q', `-a', and `-s' are always used, very few other +switches make any sense in this context. + +Note that this should be a list. I.e., do NOT use the following: + (setq nnir-namazu-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-namazu-additional-switches \\='(\"-i\" \"-w\"))" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") + "The prefix to remove from Namazu file names to get group names. +Resulting names have '/' in place 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 nnir-namazu-remove-prefix \"/home/john/Mail/\") +Note the trailing slash. Removing this prefix gives \"mail/misc/42\". +`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to +arrive at the correct group name, \"mail.misc\"." + :type '(directory) + :group 'nnir) + +(defcustom nnir-notmuch-program "notmuch" + "Name of notmuch search executable." + :version "24.1" + :type '(string) + :group 'nnir) + +(defcustom nnir-notmuch-additional-switches '() + "A list of strings, to be given as additional arguments to notmuch. + +Note that this should be a list. I.e., do NOT use the following: + (setq nnir-notmuch-additional-switches \"-i -w\") ; wrong +Instead, use this: + (setq nnir-notmuch-additional-switches \\='(\"-i\" \"-w\"))" + :version "24.1" + :type '(repeat (string)) + :group 'nnir) + +(defcustom nnir-notmuch-remove-prefix + (regexp-quote (or (getenv "MAILDIR") (expand-file-name "~/Mail"))) + "The prefix to remove from notmuch file names to get group names. +Resulting names have '/' in place of '.'. This is a regular +expression. + +This variable is very similar to `nnir-namazu-remove-prefix', except +that it is for notmuch, not Namazu." + :version "27.1" + :type '(regexp) + :group 'nnir) + +(defcustom nnir-notmuch-filter-group-names-function nil + "Whether and how to use Gnus group names as \"path:\" search terms. +When nil, the groups being searched in are not used as notmuch +:path search terms. It's still possible to use \"path:\" terms +manually within the search query, however. + +When a function, map this function over all the group names. To +use the group names unchanged, set to (lambda (g) g). Multiple +transforms (for instance, converting \".\" to \"/\") can be added +like so: + +\(add-function :filter-return + nnir-notmuch-filter-group-names-function + (lambda (g) (replace-regexp-in-string \"\\\\.\" \"/\" g)))" + :version "27.1" + :type '(choice function + (const :tag "No" nil))) + +;;; Developer Extension Variable: + +(defvar nnir-engines + `((imap nnir-run-imap + ((criteria + "Imap Search in" ; Prompt + ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing + nil ; allow any user input + nil ; initial value + nnir-imap-search-argument-history ; the history to use + ,nnir-imap-default-search-key ; default + ))) + (swish++ nnir-run-swish++ + ((swish++-group . "Swish++ Group spec (regexp): "))) + (swish-e nnir-run-swish-e + ((swish-e-group . "Swish-e Group spec (regexp): "))) + (namazu nnir-run-namazu + ()) + (notmuch nnir-run-notmuch + ()) + (hyrex nnir-run-hyrex + ((hyrex-group . "Hyrex Group spec (regexp): "))) + (find-grep nnir-run-find-grep + ((grep-options . "Grep options: ")))) + "Alist of supported search engines. +Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). +ENGINE is a symbol designating the searching engine. FUNCTION is also +a symbol, giving the function that does the search. The third element +ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, +the FUNCTION will issue a query for each of the PARAMs, using PROMPT. + +The value of `nnir-search-engine' must be one of the ENGINE symbols. +For example, for searching a server using namazu include + (nnir-search-engine namazu) +in the server definition. Note that you have to set additional +variables for most backends. For example, the `namazu' backend +needs the variables `nnir-namazu-program', +`nnir-namazu-index-directory' and `nnir-namazu-remove-prefix'. + +Add an entry here when adding a new search engine.") + +(defcustom nnir-method-default-engines '((nnimap . imap)) + "Alist of default search engines keyed by server method." + :version "27.1" + :group 'nnir + :type `(repeat (cons (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 (elem) (list 'const (car elem))) + nnir-engines))))) + + +(defmacro nnir-add-result (dirnam artno score prefix server artlist) + "Construct a result vector and add it to ARTLIST. +DIRNAM, ARTNO, SCORE, PREFIX and SERVER are passed to +`nnir-compose-result' to make the vector. Only add the result if +non-nil." + `(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server))) + (when (not (null result)) + (push result ,artlist)))) + +(autoload 'nnmaildir-base-name-to-article-number "nnmaildir") + +;; Helper function currently used by the Swish++ and Namazu backends; +;; perhaps useful for other backends as well +(defun nnir-compose-result (dirnam article score prefix server) + "Construct a result vector. +The DIRNAM, ARTICLE, SCORE, PREFIX, and SERVER are used to +construct the vector entries." + ;; remove nnir-*-remove-prefix from beginning of dirnam filename + (when (string-match (concat "^" prefix) dirnam) + (setq dirnam (replace-match "" t t dirnam))) + + (when (file-readable-p (concat prefix dirnam article)) + ;; remove trailing slash and, for nnmaildir, cur/new/tmp + (setq dirnam + (substring dirnam 0 + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) + -5 -1))) + + ;; Set group to dirnam without any leading dots or slashes, + ;; and with all subsequent slashes replaced by dots + (let ((group (replace-regexp-in-string + "[/\\]" "." + (replace-regexp-in-string "^[./\\]" "" dirnam nil t) + nil t))) + + (vector (gnus-group-full-name group server) + (if (string-match "\\`nnmaildir:" (gnus-group-server server)) + (nnmaildir-base-name-to-article-number + (substring article 0 (string-match ":" article)) + group nil) + (string-to-number article)) + (string-to-number score))))) + +;;; Search Engine Interfaces: + +(autoload 'gnus-server-get-active "gnus-int") +(autoload 'nnimap-change-group "nnimap") +(declare-function nnimap-buffer "nnimap" ()) +(declare-function nnimap-command "nnimap" (&rest args)) + +;; imap interface +(defun nnir-run-imap (query srv &optional groups) + "Run the QUERY search against an IMAP back-end server SRV. +Search GROUPS, or all active groups on SRV if GROUPS is nil. +This uses a custom query language parser; see +`nnir-imap-make-query' for details on the language and supported +extensions." + (save-excursion + (let ((qstring (cdr (assq 'query query))) + (server (cadr (gnus-server-to-method srv))) + (criteria (or (cdr (assq 'criteria query)) + (cdr (assoc nnir-imap-default-search-key + nnir-imap-search-arguments)))) + (gnus-inhibit-demon t) + (groups + (or groups (gnus-server-get-active srv nnir-ignored-newsgroups)))) + (message "Opening server %s" server) + (apply + 'vconcat + (catch 'found + (mapcar + #'(lambda (group) + (let (artlist) + (condition-case () + (when (nnimap-change-group + (gnus-group-short-name group) server) + (with-current-buffer (nnimap-buffer) + (message "Searching %s..." group) + (let ((arts 0) + (result (nnimap-command "UID SEARCH %s" + (if (string= criteria "") + qstring + (nnir-imap-make-query + criteria qstring))))) + (mapc + (lambda (artnum) + (let ((artn (string-to-number artnum))) + (when (> artn 0) + (push (vector group artn 100) + artlist) + (when (assq 'shortcut query) + (throw 'found (list artlist))) + (setq arts (1+ arts))))) + (and (car result) + (cdr (assoc "SEARCH" (cdr result))))) + (message "Searching %s... %d matches" group arts))) + (message "Searching %s...done" group)) + (quit nil)) + (nreverse artlist))) + groups)))))) + +(defun nnir-imap-make-query (criteria qstring) + "Make an IMAP search expression from QSTRING and CRITERIA. + +This implements a little language designed to return the expected +results to an arbitrary query string to the end user. + +The search is always case-insensitive, as defined by RFC2060, and +supports the following features (inspired by the Google search input +language): + +Automatic \"and\" queries + If you specify multiple words then they will be treated as an + \"and\" expression intended to match all components. + +Phrase searches + If you wrap your query in double-quotes then it will be treated + as a literal string. + +Negative terms + If you precede a term with \"-\" then it will negate that. + +\"OR\" queries + If you include an upper-case \"OR\" in your search it will cause + the term before it and the term after it to be treated as + alternatives. + +In the future the following will be added to the language: + * support for date matches + * support for location of text matching within the query + * from/to/etc headers + * additional search terms + * flag based searching + * anything else that the RFC supports, basically." + ;; Walk through the query and turn it into an IMAP query string. + (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring))) + + +(defun nnir-imap-query-to-imap (criteria query) + "Turn an s-expression format QUERY with CRITERIA into IMAP." + (mapconcat + ;; Turn the expressions into IMAP text + (lambda (item) + (nnir-imap-expr-to-imap criteria item)) + ;; The query, already in s-expr format. + query + ;; Append a space between each expression + " ")) + + +(defun nnir-imap-expr-to-imap (criteria expr) + "Convert EXPR into an IMAP search expression on CRITERIA." + ;; What sort of expression is this, eh? + (cond + ;; Simple string term + ((stringp expr) + (format "%s %S" criteria expr)) + ;; Trivial term: and + ((eq expr 'and) nil) + ;; Composite term: or expression + ((eq (car-safe expr) 'or) + (format "OR %s %s" + (nnir-imap-expr-to-imap criteria (nth 1 expr)) + (nnir-imap-expr-to-imap criteria (nth 2 expr)))) + ;; Composite term: just the fax, mam + ((eq (car-safe expr) 'not) + (format "NOT (%s)" (nnir-imap-query-to-imap criteria (cdr expr)))) + ;; Composite term: just expand it all. + ((consp expr) + (format "(%s)" (nnir-imap-query-to-imap criteria expr))) + ;; Complex value, give up for now. + (t (error "Unhandled input: %S" expr)))) + + +(defun nnir-imap-parse-query (string) + "Turn STRING into an s-expression query. +STRING is based on the IMAP query language as defined in +`nnir-imap-make-query'. + +This involves turning individual tokens into higher level terms +that the search language can then understand and use." + (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 (nnir-imap-end-of-input)) + (push (nnir-imap-next-expr) out)) + (reverse out)))) + + +(defun nnir-imap-next-expr (&optional count) + "Return the next (COUNT) expression from the current buffer." + (let ((term (nnir-imap-next-term count)) + (next (nnir-imap-peek-symbol))) + ;; Are we looking at an 'or' expression? + (cond + ;; Handle 'expr or expr' + ((eq next 'or) + (list 'or term (nnir-imap-next-expr 2))) + ;; Anything else + (t term)))) + + +(defun nnir-imap-next-term (&optional count) + "Return the next (COUNT) term from the current buffer." + (let ((term (nnir-imap-next-symbol count))) + ;; What sort of term is this? + (cond + ;; and -- just ignore it + ((eq term 'and) 'and) + ;; negated term + ((eq term 'not) (list 'not (nnir-imap-next-expr))) + ;; generic term + (t term)))) + + +(defun nnir-imap-peek-symbol () + "Return the next symbol from the current buffer, but don't consume it." + (save-excursion + (nnir-imap-next-symbol))) + +(defun nnir-imap-next-symbol (&optional count) + "Return the next (COUNT) symbol from the current buffer. +Return 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)) + (nnir-imap-next-symbol (1- count))) + (let ((case-fold-search t)) + ;; end of input stream? + (unless (nnir-imap-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) + ;; quoted string + ((looking-at "\"") (nnir-imap-delimited-string "\"")) + ;; list expression -- we parse the content and return this as a list. + ((looking-at "(") + (nnir-imap-parse-query (nnir-imap-delimited-string ")"))) + ;; 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) + ;; Simple, boring keyword + (t (let ((start (point)) + (end (if (search-forward-regexp "[[:blank:]]" nil t) + (prog1 + (match-beginning 0) + ;; unskip if we hit a non-blank terminal character. + (when (string-match "[^[:blank:]]" (match-string 0)) + (backward-char 1))) + (goto-char (point-max))))) + (buffer-substring start end))))))) + +(defun nnir-imap-delimited-string (delimiter) + "Return a string delimited by DELIMITER from the current buffer." + (let ((start (point)) end) + (forward-char 1) ; skip the first delimiter. + (while (not end) + (unless (search-forward delimiter nil t) + (error "Unmatched delimited input with %s in query" delimiter)) + (let ((here (point))) + (unless (equal (buffer-substring (- here 2) (- here 1)) "\\") + (setq end (point))))) + (buffer-substring (1+ start) (1- end)))) + +(defun nnir-imap-end-of-input () + "Are we at the end of input?" + (skip-chars-forward "[:blank:]") + (looking-at "$")) + + +;; Swish++ interface. +;; -cc- Todo +;; Search by +;; - group +;; Sort by +;; - rank (default) +;; - article number +;; - file size +;; - group +(defun nnir-run-swish++ (query server &optional _group) + "Run QUERY on SERVER against swish++. +Returns a vector of (group name, file name) pairs (also vectors, +actually). + +Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on +Windows NT 4.0." + + ;; (when group + ;; (error "The swish++ backend cannot search specific groups")) + + (save-excursion + (let ( (qstring (cdr (assq 'query query))) + (groupspec (cdr (assq 'swish++-group query))) + (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) + artlist + ;; nnml-use-compressed-files might be any string, but probably this + ;; is sufficient. Note that we can't only use the value of + ;; nnml-use-compressed-files because old articles might have been + ;; saved with a different value. + (article-pattern (if (string-match "\\`nnmaildir:" + (gnus-group-server server)) + ":[0-9]+" + "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) + score artno dirnam filenam) + + (when (equal "" qstring) + (error "swish++: You didn't enter anything")) + + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (if groupspec + (message "Doing swish++ query %s on %s..." qstring groupspec) + (message "Doing swish++ query %s..." qstring)) + + (let* ((cp-list `( ,nnir-swish++-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server) + ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server) + ,qstring ; the query, in swish++ format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-swish++-program + (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? + (apply #'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) + ;; swish++ failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; V 4.7 Linux + ;; rank relative-path-name file-size file-title + ;; V 5.0b2: + ;; rank relative-path-name file-size topic?? + ;; where rank is an integer from 1 to 100. + (goto-char (point-min)) + (while (re-search-forward + "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t) + (setq score (match-string 1) + filenam (match-string 2) + artno (file-name-nondirectory filenam) + dirnam (file-name-directory filenam)) + + ;; don't match directories + (when (string-match article-pattern artno) + (when (not (null dirnam)) + + ;; maybe limit results to matching groups. + (when (or (not groupspec) + (string-match groupspec dirnam)) + (nnir-add-result dirnam artno score prefix server artlist))))) + + (message "Massaging swish++ output...done") + + ;; Sort by score + (apply #'vector + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +;; Swish-E interface. +(defun nnir-run-swish-e (query server &optional _group) + "Run given QUERY on SERVER against swish-e. +Returns a vector of (group name, file name) pairs (also vectors, +actually). + +Tested with swish-e-2.0.1 on Windows NT 4.0." + + ;; swish-e crashes with empty parameter to "-w" on commandline... + ;; (when group + ;; (error "The swish-e backend cannot search specific groups")) + + (save-excursion + (let ((qstring (cdr (assq 'query query))) + (prefix + (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server) + (error "Missing parameter `nnir-swish-e-remove-prefix'"))) + artlist score artno dirnam group ) + + (when (equal "" qstring) + (error "swish-e: You didn't enter anything")) + + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (message "Doing swish-e query %s..." query) + (let* ((index-files + (or (nnir-read-server-parm + 'nnir-swish-e-index-files server) + (error "Missing parameter `nnir-swish-e-index-files'"))) + (additional-switches + (nnir-read-server-parm + 'nnir-swish-e-additional-switches server)) + (cp-list `(,nnir-swish-e-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-f" ,@index-files + ,@additional-switches + "-w" + ,qstring ; the query, in swish-e format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-swish-e-program + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) + ;; swish-e failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; rank path-name file-title file-size + (goto-char (point-min)) + (while (re-search-forward + "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t) + (setq score (match-string 1) + artno (match-string 3) + dirnam (file-name-directory (match-string 2))) + + ;; don't match directories + (when (string-match "^[0-9]+$" artno) + (when (not (null dirnam)) + + ;; remove nnir-swish-e-remove-prefix from beginning of dirname + (when (string-match (concat "^" prefix) dirnam) + (setq dirnam (replace-match "" t t dirnam))) + + (setq dirnam (substring dirnam 0 -1)) + ;; eliminate all ".", "/", "\" from beginning. Always matches. + (string-match "^[./\\]*\\(.*\\)$" dirnam) + ;; "/" -> "." + (setq group (replace-regexp-in-string + "/" "." (match-string 1 dirnam))) + ;; Windows "\\" -> "." + (setq group (replace-regexp-in-string "\\\\" "." group)) + + (push (vector (gnus-group-full-name group server) + (string-to-number artno) + (string-to-number score)) + artlist)))) + + (message "Massaging swish-e output...done") + + ;; Sort by score + (apply #'vector + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +;; HyREX interface +(defun nnir-run-hyrex (query server &optional group) + "Run given QUERY with GROUP on SERVER against hyrex." + (save-excursion + (let ((artlist nil) + (groupspec (cdr (assq 'hyrex-group query))) + (qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) + score artno dirnam) + (when (and (not groupspec) group) + (setq groupspec + (regexp-opt + (mapcar (lambda (x) (gnus-group-real-name x)) group)))) + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (message "Doing hyrex-search query %s..." query) + (let* ((cp-list + `( ,nnir-hyrex-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory + ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server) + ,qstring ; the query, in hyrex-search format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-hyrex-program + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) + ;; nnir-search failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) ;; FIXME: Don't clear buffer ! + (message "Doing hyrex-search query \"%s\"...done" qstring) + (sit-for 0) + ;; nnir-search returns: + ;; for nnml/nnfolder: "filename mailid weight" + ;; for nnimap: "group mailid weight" + (goto-char (point-min)) + (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") + ;; HyREX doesn't search directly in groups -- so filter out here. + (when groupspec + (keep-lines groupspec)) + ;; extract data from result lines + (goto-char (point-min)) + (while (re-search-forward + "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t) + (setq dirnam (match-string 1) + artno (match-string 2) + score (match-string 3)) + (when (string-match prefix dirnam) + (setq dirnam (replace-match "" t t dirnam))) + (push (vector (gnus-group-full-name + (replace-regexp-in-string "/" "." dirnam) server) + (string-to-number artno) + (string-to-number score)) + artlist)) + (message "Massaging hyrex-search output...done.") + (apply #'vector + (sort artlist + (function (lambda (x y) + (if (string-lessp (nnir-artitem-group x) + (nnir-artitem-group y)) + t + (< (nnir-artitem-number x) + (nnir-artitem-number y))))))) + ))) + +;; Namazu interface +(defun nnir-run-namazu (query server &optional _group) + "Run QUERY on SERVER against Namazu. +Returns a vector of (group name, file name) pairs (also vectors, +actually). + +Tested with Namazu 2.0.6 on a GNU/Linux system." + ;; (when group + ;; (error "The Namazu backend cannot search specific groups")) + (save-excursion + (let ((article-pattern (if (string-match "\\`nnmaildir:" + (gnus-group-server server)) + ":[0-9]+" + "^[0-9]+$")) + artlist + (qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server)) + score group article + (process-environment (copy-sequence process-environment))) + (setenv "LC_MESSAGES" "C") + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + (let* ((cp-list + `( ,nnir-namazu-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "-q" ; don't be verbose + "-a" ; show all matches + "-s" ; use short format + ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server) + ,qstring ; the query, in namazu format + ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory + )) + (exitstatus + (progn + (message "%s args: %s" nnir-namazu-program + (mapconcat #'identity (nthcdr 4 cp-list) " ")) + (apply #'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) + ;; Namazu failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; Namazu output looks something like this: + ;; 2. Re: Gnus agent expire broken (score: 55) + ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes) + + (goto-char (point-min)) + (while (re-search-forward + "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" + nil t) + (setq score (match-string 3) + group (file-name-directory (match-string 4)) + article (file-name-nondirectory (match-string 4))) + + ;; make sure article and group is sane + (when (and (string-match article-pattern article) + (not (null group))) + (nnir-add-result group article score prefix server artlist))) + + ;; sort artlist by score + (apply #'vector + (sort artlist + (function (lambda (x y) + (> (nnir-artitem-rsv x) + (nnir-artitem-rsv y))))))))) + +(defun nnir-run-notmuch (query server &optional groups) + "Run QUERY with GROUPS from SERVER against notmuch. +Returns a vector of (group name, file name) pairs (also vectors, +actually). If GROUPS is a list of group names, use them to +construct path: search terms (see the variable +`nnir-notmuch-filter-group-names-function')." + + (save-excursion + (let* ((qstring (cdr (assq 'query query))) + (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) + artlist + (article-pattern (if (string-match "\\`nnmaildir:" + (gnus-group-server server)) + ":[0-9]+" + "^[0-9]+$")) + (groups (when nnir-notmuch-filter-group-names-function + (delq nil + (mapcar nnir-notmuch-filter-group-names-function + (mapcar #'gnus-group-short-name groups))))) + (pathquery (when groups + (concat " (" + (mapconcat (lambda (g) + (format "path:%s" g)) + groups " or") + ")"))) + artno dirnam filenam) + + (when (equal "" qstring) + (error "notmuch: You didn't enter anything")) + + (set-buffer (gnus-get-buffer-create nnir-tmp-buffer)) + (erase-buffer) + + (if groups + (message "Doing notmuch query %s on %s..." + qstring (mapconcat #'identity groups " ")) + (message "Doing notmuch query %s..." qstring)) + + (when groups + (setq qstring (concat qstring pathquery))) + + (let* ((cp-list `( ,nnir-notmuch-program + nil ; input from /dev/null + t ; output + nil ; don't redisplay + "search" + "--format=text" + "--output=files" + ,@(nnir-read-server-parm 'nnir-notmuch-additional-switches server) + ,qstring ; the query, in notmuch format + )) + (exitstatus + (progn + (message "%s args: %s" nnir-notmuch-program + (mapconcat #'identity (nthcdr 4 cp-list) " ")) ;; ??? + (apply #'call-process cp-list)))) + (unless (or (null exitstatus) + (zerop exitstatus)) + (nnheader-report 'nnir "Couldn't run notmuch: %s" exitstatus) + ;; notmuch failure reason is in this buffer, show it if + ;; the user wants it. + (when (> gnus-verbose 6) + (display-buffer nnir-tmp-buffer)))) + + ;; The results are output in the format of: + ;; absolute-path-name + (goto-char (point-min)) + (while (not (eobp)) + (setq filenam (buffer-substring-no-properties (line-beginning-position) + (line-end-position)) + artno (file-name-nondirectory filenam) + dirnam (file-name-directory filenam)) + (forward-line 1) + + ;; don't match directories + (when (string-match article-pattern artno) + (when (not (null dirnam)) + + (nnir-add-result dirnam artno "" prefix server artlist)))) + + (message "Massaging notmuch output...done") + + artlist))) + +(defun nnir-run-find-grep (query server &optional grouplist) + "Run find and grep to QUERY GROUPLIST on SERVER for matching articles." + (let* ((method (gnus-server-to-method server)) + (sym (intern + (concat (symbol-name (car method)) "-directory"))) + (directory (cadr (assoc sym (cddr method)))) + (regexp (cdr (assoc 'query query))) + (grep-options (cdr (assoc 'grep-options query))) + (grouplist + (or grouplist (gnus-server-get-active server nnir-ignored-newsgroups)))) + (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 (gnus-get-buffer-create nnir-tmp-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" + "grep" + `("-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 + ;; Replace cl-func: + ;; (subseq path 0 -1) + (let ((end (1- (length path))) + res) + (while + (>= (setq end (1- end)) 0) + (push (pop path) res)) + (nreverse res)) + "."))) + (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)) + +;;; Util Code: + + +(defun nnir-read-parms (nnir-search-engine) + "Read additional search parameters for NNIR-SEARCH-ENGINE. +Parameters are according to `nnir-engines'." + (let ((parmspec (nth 2 (assoc nnir-search-engine nnir-engines)))) + (mapcar #'nnir-read-parm parmspec))) + +(defun nnir-read-parm (parmspec) + "Read a single search parameter. +PARMSPEC is a cons cell, the car is a symbol, the cdr is a prompt." + (let ((sym (car parmspec)) + (prompt (cdr parmspec))) + (if (listp prompt) + (let* ((result (apply #'gnus-completing-read prompt)) + (mapping (or (assoc result nnir-imap-search-arguments) + (cons nil nnir-imap-search-other)))) + (cons sym (format (cdr mapping) result))) + (cons sym (read-string prompt))))) + +(defun nnir-run-query (specs) + "Invoke search engine appropriate for SPECS (see `nnir-engines')." + (apply #'vconcat + (mapcar + (lambda (x) + (let* ((server (car x)) + (search-engine (nnir-server-to-search-engine server)) + (search-func (cadr (assoc search-engine nnir-engines)))) + (and search-func + (funcall search-func (cdr (assq 'nnir-query-spec specs)) + server (cdr x))))) + (cdr (assq 'nnir-group-spec specs))))) + +(defun nnir-server-to-search-engine (server) + "Find search engine for SERVER." + (or (nnir-read-server-parm 'nnir-search-engine server t) + (cdr (assoc (car (gnus-server-to-method server)) + nnir-method-default-engines)))) + +(defun nnir-read-server-parm (key server &optional not-global) + "Return the parameter value corresponding to KEY for SERVER. +If no server-specific value is found consult the global +environment unless NOT-GLOBAL is non-nil." + (let ((method (gnus-server-to-method server))) + (cond ((and method (assq key (cddr method))) + (nth 1 (assq key (cddr method)))) + ((and (not not-global) (boundp key)) (symbol-value key)) + (t nil)))) + +(autoload 'gnus-group-topic-name "gnus-topic" nil nil) +(defvar gnus-group-marked) +(defvar gnus-topic-alist) + +(make-obsolete 'nnir-make-specs "This function should no longer +be used." "28.1") + +(defun nnir-make-specs (nnir-extra-parms &optional specs) + "Make the query-spec and group-spec for a search with NNIR-EXTRA-PARMS. +Query for the specs, or use SPECS." + (let* ((group-spec + (or (cdr (assq 'nnir-group-spec specs)) + (if (gnus-server-server-name) + (list (list (gnus-server-server-name))) + (seq-group-by + (lambda (elt) (gnus-group-server elt)) + (or gnus-group-marked + (if (gnus-group-group-name) + (list (gnus-group-group-name)) + (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)))))) + (list (cons 'nnir-query-spec query-spec) + (cons 'nnir-group-spec group-spec)))) + +(define-obsolete-function-alias 'nnir-get-active 'gnus-server-get-active "28.1") + +;; The end. +(provide 'nnir) + +;;; nnir.el ends here