Add docstrings
[gnus] / lisp / nnir.el
1 ;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
2
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;;   2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5
6 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
7 ;; Swish-e and Swish++ backends by:
8 ;;   Christoph Conrad <christoph.conrad@gmx.de>.
9 ;; IMAP backend by: Simon Josefsson <jas@pdc.kth.se>.
10 ;; IMAP search by: Torsten Hilbrich <torsten.hilbrich <at> gmx.net>
11 ;; IMAP search improved by Daniel Pittman  <daniel@rimspace.net>.
12 ;; nnmaildir support for Swish++ and Namazu backends by:
13 ;;   Justus Piater <Justus <at> Piater.name>
14 ;; Keywords: news mail searching ir
15
16 ;; This file is part of GNU Emacs.
17
18 ;; GNU Emacs is free software: you can redistribute it and/or modify
19 ;; it under the terms of the GNU General Public License as published by
20 ;; the Free Software Foundation, either version 3 of the License, or
21 ;; (at your option) any later version.
22
23 ;; GNU Emacs is distributed in the hope that it will be useful,
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
26 ;; GNU General Public License for more details.
27
28 ;; You should have received a copy of the GNU General Public License
29 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
30
31 ;;; Commentary:
32
33 ;; TODO: Documentation in the Gnus manual
34
35 ;; From: Reiner Steib
36 ;; Subject: Re: Including nnir.el
37 ;; Newsgroups: gmane.emacs.gnus.general
38 ;; Message-ID: <v9d5dnp6aq.fsf@marauder.physik.uni-ulm.de>
39 ;; Date: 2006-06-05 22:49:01 GMT
40 ;;
41 ;; On Sun, Jun 04 2006, Sascha Wilde wrote:
42 ;;
43 ;; > The one thing most hackers like to forget: Documentation.  By now the
44 ;; > documentation is only in the comments at the head of the source, I
45 ;; > would use it as basis to cook up some minimal texinfo docs.
46 ;; >
47 ;; > Where in the existing gnus manual would this fit best?
48
49 ;; Maybe (info "(gnus)Combined Groups") for a general description.
50 ;; `gnus-group-make-nnir-group' might be described in (info
51 ;; "(gnus)Foreign Groups") as well.
52
53
54 ;; The most recent version of this can always be fetched from the Gnus
55 ;; repository.  See http://www.gnus.org/ for more information.
56
57 ;; This code is still in the development stage but I'd like other
58 ;; people to have a look at it.  Please do not hesitate to contact me
59 ;; with your ideas.
60
61 ;; What does it do?  Well, it allows you to index your mail using some
62 ;; search engine (freeWAIS-sf, swish-e and others -- see later),
63 ;; then type `G G' in the Group buffer and issue a query to the search
64 ;; engine.  You will then get a buffer which shows all articles
65 ;; matching the query, sorted by Retrieval Status Value (score).
66
67 ;; When looking at the retrieval result (in the Summary buffer) you
68 ;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an
69 ;; article.  You will be teleported into the group this article came
70 ;; from, showing the thread this article is part of.  (See below for
71 ;; restrictions.)
72
73 ;; The Lisp installation is simple: just put this file on your
74 ;; load-path, byte-compile it, and load it from ~/.gnus or something.
75 ;; This will install a new command `G G' in your Group buffer for
76 ;; searching your mail.  Note that you also need to configure a number
77 ;; of variables, as described below.
78
79 ;; Restrictions:
80 ;;
81 ;; * This expects that you use nnml or another one-file-per-message backend,
82 ;;   because the others doesn't support nnfolder.
83 ;; * It can only search the mail backend's which are supported by one
84 ;;   search engine, because of different query languages.
85 ;; * There are restrictions to the Wais setup.
86 ;; * There are restrictions to the imap setup.
87 ;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before
88 ;;   limiting to the right articles.  This is much too slow, of
89 ;;   course.  May issue a query for number of articles to fetch; you
90 ;;   must accept the default of all articles at this point or things
91 ;;   may break.
92
93 ;; The Lisp setup involves setting a few variables and setting up the
94 ;; search engine. You can define the variables in the server definition
95 ;; like this :
96 ;;   (setq gnus-secondary-select-methods '(
97 ;;       (nnimap "" (nnimap-address "localhost")
98 ;;                  (nnir-search-engine namazu)
99 ;;       )))
100 ;; Or you can define the global ones. The variables set in the mailer-
101 ;; definition will be used first.
102 ;; The variable to set is `nnir-search-engine'.  Choose one of the engines
103 ;; listed in `nnir-engines'.  (Actually `nnir-engines' is an alist,
104 ;; type `C-h v nnir-engines RET' for more information; this includes
105 ;; examples for setting `nnir-search-engine', too.)
106 ;;
107 ;; The variable nnir-mail-backend isn't used anymore.
108 ;;
109
110 ;; You must also set up a search engine.  I'll tell you about the two
111 ;; search engines currently supported:
112
113 ;; 1. freeWAIS-sf
114 ;;
115 ;; As always with freeWAIS-sf, you need a so-called `format file'.  I
116 ;; use the following file:
117 ;;
118 ;; ,-----
119 ;; | # Kai's format file for freeWAIS-sf for indexing mails.
120 ;; | # Each mail is in a file, much like the MH format.
121 ;; |
122 ;; | # Document separator should never match -- each file is a document.
123 ;; | record-sep: /^@this regex should never match@$/
124 ;; |
125 ;; | # Searchable fields specification.
126 ;; |
127 ;; | region: /^[sS]ubject:/ /^[sS]ubject: */
128 ;; |         subject "Subject header" stemming TEXT BOTH
129 ;; | end: /^[^ \t]/
130 ;; |
131 ;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */
132 ;; |         to "To and Cc headers" SOUNDEX BOTH
133 ;; | end: /^[^ \t]/
134 ;; |
135 ;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */
136 ;; |         from "From header" SOUNDEX BOTH
137 ;; | end: /^[^ \t]/
138 ;; |
139 ;; | region: /^$/
140 ;; |         stemming TEXT GLOBAL
141 ;; | end: /^@this regex should never match@$/
142 ;; `-----
143 ;;
144 ;; 1998-07-22: waisindex would dump core on me for large articles with
145 ;; the above settings.  I used /^$/ as the end regex for the global
146 ;; field.  That seemed to work okay.
147
148 ;; There is a Perl module called `WAIS.pm' which is available from
149 ;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl.  This
150 ;; module comes with a nifty tool called `makedb', which I use for
151 ;; indexing.  Here's my `makedb.conf':
152 ;;
153 ;; ,-----
154 ;; | # Config file for makedb
155 ;; |
156 ;; | # Global options
157 ;; | waisindex = /usr/local/bin/waisindex
158 ;; | wais_opt  = -stem -t fields
159 ;; | # `-stem' option necessary when `stemming' is specified for the
160 ;; | # global field in the *.fmt file
161 ;; |
162 ;; | # Own variables
163 ;; | homedir = /home/kai
164 ;; |
165 ;; | # The mail database.
166 ;; | database        = mail
167 ;; | files           = `find $homedir/Mail -name \*[0-9] -print`
168 ;; | dbdir           = $homedir/.wais
169 ;; | limit           = 100
170 ;; `-----
171 ;;
172 ;; The Lisp setup involves the `nnir-wais-*' variables.  The most
173 ;; difficult to understand variable is probably
174 ;; `nnir-wais-remove-prefix'.  Here's what it does: the output of
175 ;; `waissearch' basically contains the file name and the (full)
176 ;; directory name.  As Gnus works with group names rather than
177 ;; directory names, the directory name is transformed into a group
178 ;; name as follows: first, a prefix is removed from the (full)
179 ;; directory name, then all `/' are replaced with `.'.  The variable
180 ;; `nnir-wais-remove-prefix' should contain a regex matching exactly
181 ;; this prefix.  It defaults to `$HOME/Mail/' (note the trailing
182 ;; slash).
183
184 ;; 2. Namazu
185 ;;
186 ;; The Namazu backend requires you to have one directory containing all
187 ;; index files, this is controlled by the `nnir-namazu-index-directory'
188 ;; variable.  To function the `nnir-namazu-remove-prefix' variable must
189 ;; also be correct, see the documentation for `nnir-wais-remove-prefix'
190 ;; above.
191 ;;
192 ;; It is particularly important not to pass any any switches to namazu
193 ;; that will change the output format.  Good switches to use include
194 ;; `--sort', `--ascending', `--early' and `--late'.  Refer to the Namazu
195 ;; documentation for further information on valid switches.
196 ;;
197 ;; To index my mail with the `mknmz' program I use the following
198 ;; configuration file:
199 ;;
200 ;; ,----
201 ;; | package conf;  # Don't remove this line!
202 ;; |
203 ;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
204 ;; | $EXCLUDE_PATH = "spam|sent";
205 ;; |
206 ;; | # Header fields which should be searchable. case-insensitive
207 ;; | $REMAIN_HEADER = "from|date|message-id|subject";
208 ;; |
209 ;; | # Searchable fields. case-insensitive
210 ;; | $SEARCH_FIELD = "from|date|message-id|subject";
211 ;; |
212 ;; | # The max length of a word.
213 ;; | $WORD_LENG_MAX = 128;
214 ;; |
215 ;; | # The max length of a field.
216 ;; | $MAX_FIELD_LENGTH = 256;
217 ;; `----
218 ;;
219 ;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and
220 ;; ~/Mail/archive/, so to index them I go to the directory set in
221 ;; `nnir-namazu-index-directory' and issue the following command.
222 ;;
223 ;;      mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
224 ;;
225 ;; For maximum searching efficiency I have a cron job set to run this
226 ;; command every four hours.
227
228 ;; 3. find-grep
229 ;;
230 ;; The find-grep engine simply runs find(1) to locate eligible
231 ;; articles and searches them with grep(1).  This, of course, is much
232 ;; slower than using a proper search engine but OTOH doesn't require
233 ;; maintenance of an index and is still faster than using any built-in
234 ;; means for searching.  The method specification of the server to
235 ;; search must include a directory for this engine to work (E.g.,
236 ;; `nnml-directory').  The tools must be POSIX compliant.  GNU Find
237 ;; prior to version 4.2.12 (4.2.26 on Linux due to incorrect ARG_MAX
238 ;; handling) does not work.
239 ;; ,----
240 ;; |    ;; find-grep configuration for searching the Gnus Cache
241 ;; |
242 ;; |    (nnml "cache"
243 ;; |          (nnml-get-new-mail nil)
244 ;; |          (nnir-search-engine find-grep)
245 ;; |          (nnml-directory "~/News/cache/")
246 ;; |          (nnml-active-file "~/News/cache/active"))
247 ;; `----
248
249 ;; Developer information:
250
251 ;; I have tried to make the code expandable.  Basically, it is divided
252 ;; into two layers.  The upper layer is somewhat like the `nnvirtual'
253 ;; backend: given a specification of what articles to show from
254 ;; another backend, it creates a group containing exactly those
255 ;; articles.  The lower layer issues a query to a search engine and
256 ;; produces such a specification of what articles to show from the
257 ;; other backend.
258
259 ;; The interface between the two layers consists of the single
260 ;; function `nnir-run-query', which just selects the appropriate
261 ;; function for the search engine one is using.  The input to
262 ;; `nnir-run-query' is a string, representing the query as input by
263 ;; the user.  The output of `nnir-run-query' is supposed to be a
264 ;; vector, each element of which should in turn be a three-element
265 ;; vector.  The first element should be full group name of the article,
266 ;; the second element should be the article number, and the third
267 ;; element should be the Retrieval Status Value (RSV) as returned from
268 ;; the search engine.  An RSV is the score assigned to the document by
269 ;; the search engine.  For Boolean search engines, the
270 ;; RSV is always 1000 (or 1 or 100, or whatever you like).
271
272 ;; The sorting order of the articles in the summary buffer created by
273 ;; nnir is based on the order of the articles in the above mentioned
274 ;; vector, so that's where you can do the sorting you'd like.  Maybe
275 ;; it would be nice to have a way of displaying the search result
276 ;; sorted differently?
277
278 ;; So what do you need to do when you want to add another search
279 ;; engine?  You write a function that executes the query.  Temporary
280 ;; data from the search engine can be put in `nnir-tmp-buffer'.  This
281 ;; function should return the list of articles as a vector, as
282 ;; described above.  Then, you need to register this backend in
283 ;; `nnir-engines'.  Then, users can choose the backend by setting
284 ;; `nnir-search-engine'.
285
286 ;; Todo, or future ideas:
287
288 ;; * It should be possible to restrict search to certain groups.
289 ;;
290 ;; * There is currently no error checking.
291 ;;
292 ;; * The summary buffer display is currently really ugly, with all the
293 ;;   added information in the subjects.  How could I make this
294 ;;   prettier?
295 ;;
296 ;; * A function which can be called from an nnir summary buffer which
297 ;;   teleports you into the group the current article came from and
298 ;;   shows you the whole thread this article is part of.
299 ;;   Implementation suggestions?
300 ;;   (1998-07-24: There is now a preliminary implementation, but
301 ;;   it is much too slow and quite fragile.)
302 ;;
303 ;; * Support other mail backends.  In particular, probably quite a few
304 ;;   people use nnfolder.  How would one go about searching nnfolders
305 ;;   and producing the right data needed?  The group name and the RSV
306 ;;   are simple, but what about the article number?
307 ;;   - The article number is encoded in the `X-Gnus-Article-Number'
308 ;;     header of each mail.
309 ;;
310 ;; * Support compressed mail files.  Probably, just stripping off the
311 ;;   `.gz' or `.Z' file name extension is sufficient.
312 ;;
313 ;; * At least for imap, the query is performed twice.
314 ;;
315
316 ;; Have you got other ideas?
317
318 ;;; Setup Code:
319
320 (require 'nnoo)
321 (require 'gnus-group)
322 (require 'gnus-sum)
323 (require 'message)
324 (require 'gnus-util)
325 (eval-when-compile
326   (require 'cl))
327
328
329 (eval-when-compile
330   (autoload 'nnimap-buffer "nnimap")
331   (autoload 'nnimap-command "nnimap")
332   (autoload 'nnimap-possibly-change-group "nnimap"))
333
334 (nnoo-declare nnir)
335 (nnoo-define-basics nnir)
336
337 (gnus-declare-backend "nnir" 'mail)
338
339 (defvar nnir-imap-default-search-key "Whole message"
340   "The default IMAP search key for an nnir search. Must be one of
341   the keys in nnir-imap-search-arguments. To use raw imap queries
342   by default set this to \"Imap\"")
343
344 (defvar nnir-imap-search-arguments
345   '(("Whole message" . "TEXT")
346     ("Subject" . "SUBJECT")
347     ("To" . "TO")
348     ("From" . "FROM")
349     ("Imap" . ""))
350   "Mapping from user readable keys to IMAP search items for use in nnir")
351
352 (defvar nnir-imap-search-other "HEADER %S"
353   "The IMAP search item to use for anything other than
354   nnir-imap-search-arguments. By default this is the name of an
355   email header field")
356
357 (defvar nnir-imap-search-argument-history ()
358   "The history for querying search options in nnir")
359
360 (defvar nnir-get-article-nov-override-function nil
361   "If non-nil, a function that will be passed each search result.  This
362 should return a message's headers in NOV format.
363
364 If this variable is nil, or if the provided function returns nil for a search
365 result, `gnus-retrieve-headers' will be called instead.")
366
367 (defvar nnir-method-default-engines
368   '((nnimap . imap)
369     (nntp . nil))
370   "Alist of default search engines by server method")
371
372 ;;; Developer Extension Variable:
373
374 (defvar nnir-engines
375   `((wais    nnir-run-waissearch
376              ())
377     (imap    nnir-run-imap
378              ((criteria
379                "Search in"                        ; Prompt
380                ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing
381                nil                                ; allow any user input
382                nil                                ; initial value
383                nnir-imap-search-argument-history  ; the history to use
384                ,nnir-imap-default-search-key      ; default
385                )))
386     (swish++ nnir-run-swish++
387              ((group . "Group spec: ")))
388     (swish-e nnir-run-swish-e
389              ((group . "Group spec: ")))
390     (namazu  nnir-run-namazu
391              ())
392     (find-grep nnir-run-find-grep
393                ((grep-options . "Grep options: "))))
394   "Alist of supported search engines.
395 Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
396 ENGINE is a symbol designating the searching engine.  FUNCTION is also
397 a symbol, giving the function that does the search.  The third element
398 ARGS is a list of cons pairs (PARAM . PROMPT).  When issuing a query,
399 the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
400
401 The value of `nnir-search-engine' must be one of the ENGINE symbols.
402 For example, use the following line for searching using freeWAIS-sf:
403     (setq nnir-search-engine 'wais)
404 Use the following line if you read your mail via IMAP and your IMAP
405 server supports searching:
406     (setq nnir-search-engine 'imap)
407 Note that you have to set additional variables for most backends.  For
408 example, the `wais' backend needs the variables `nnir-wais-program',
409 `nnir-wais-database' and `nnir-wais-remove-prefix'.
410
411 Add an entry here when adding a new search engine.")
412
413 ;;; User Customizable Variables:
414
415 (defgroup nnir nil
416   "Search nnmh and nnml groups in Gnus with swish-e, freeWAIS-sf, or EWS."
417   :group 'gnus)
418
419 ;; Mail backend.
420
421 ;; TODO:
422 ;; If `nil', use server parameters to find out which server to search. CCC
423 ;;
424 (defcustom nnir-mail-backend '(nnml "")
425   "*Specifies which backend should be searched.
426 More precisely, this is used to determine from which backend to fetch the
427 messages found.
428
429 This must be equal to an existing server, so maybe it is best to use
430 something like the following:
431     (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods))
432 The above line works fine if the mail backend you want to search is
433 the first element of gnus-secondary-select-methods (`nth' starts counting
434 at zero)."
435   :type '(sexp)
436   :group 'nnir)
437
438 ;; Search engine to use.
439
440 (defcustom nnir-search-engine 'wais
441   "*The search engine to use.  Must be a symbol.
442 See `nnir-engines' for a list of supported engines, and for example
443 settings of `nnir-search-engine'."
444   :type '(sexp)
445   :group 'nnir)
446
447 ;; freeWAIS-sf.
448
449 (defcustom nnir-wais-program "waissearch"
450   "*Name of waissearch executable."
451   :type '(string)
452   :group 'nnir)
453
454 (defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
455   "*Name of Wais database containing the mail.
456
457 Note that this should be a file name without extension.  For example,
458 if you have a file /home/john/.wais/mail.fmt, use this:
459     (setq nnir-wais-database \"/home/john/.wais/mail\")
460 The string given here is passed to `waissearch -d' as-is."
461   :type '(file)
462   :group 'nnir)
463
464 (defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/")
465   "*The prefix to remove from each directory name returned by waissearch
466 in order to get a group name (albeit with / instead of .).  This is a
467 regular expression.
468
469 For example, suppose that Wais returns file names such as
470 \"/home/john/Mail/mail/misc/42\".  For this example, use the following
471 setting:  (setq nnir-wais-remove-prefix \"/home/john/Mail/\")
472 Note the trailing slash.  Removing this prefix gives \"mail/misc/42\".
473 `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
474 arrive at the correct group name, \"mail.misc\"."
475   :type '(regexp)
476   :group 'nnir)
477
478 (defcustom nnir-swish++-configuration-file
479   (expand-file-name "~/Mail/swish++.conf")
480   "*Configuration file for swish++."
481   :type '(file)
482   :group 'nnir)
483
484 (defcustom nnir-swish++-program "search"
485   "*Name of swish++ search executable."
486   :type '(string)
487   :group 'nnir)
488
489 (defcustom nnir-swish++-additional-switches '()
490   "*A list of strings, to be given as additional arguments to swish++.
491
492 Note that this should be a list.  Ie, do NOT use the following:
493     (setq nnir-swish++-additional-switches \"-i -w\") ; wrong
494 Instead, use this:
495     (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
496   :type '(repeat (string))
497   :group 'nnir)
498
499 (defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
500   "*The prefix to remove from each file name returned by swish++
501 in order to get a group name (albeit with / instead of .).  This is a
502 regular expression.
503
504 This variable is very similar to `nnir-wais-remove-prefix', except
505 that it is for swish++, not Wais."
506   :type '(regexp)
507   :group 'nnir)
508
509 ;; Swish-E.
510 ;; URL: http://swish-e.org/
511 ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and
512 ;; `nnir-swish-e-additional-switches'
513
514 (make-obsolete-variable 'nnir-swish-e-index-file
515                         'nnir-swish-e-index-files "Emacs 23.1")
516 (defcustom nnir-swish-e-index-file
517   (expand-file-name "~/Mail/index.swish-e")
518   "*Index file for swish-e.
519 This could be a server parameter.
520 It is never consulted once `nnir-swish-e-index-files', which should be
521 used instead, has been customized."
522   :type '(file)
523   :group 'nnir)
524
525 (defcustom nnir-swish-e-index-files
526   (list nnir-swish-e-index-file)
527   "*List of index files for swish-e.
528 This could be a server parameter."
529   :type '(repeat (file))
530   :group 'nnir)
531
532 (defcustom nnir-swish-e-program "swish-e"
533   "*Name of swish-e search executable.
534 This cannot be a server parameter."
535   :type '(string)
536   :group 'nnir)
537
538 (defcustom nnir-swish-e-additional-switches '()
539   "*A list of strings, to be given as additional arguments to swish-e.
540
541 Note that this should be a list.  Ie, do NOT use the following:
542     (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
543 Instead, use this:
544     (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))
545
546 This could be a server parameter."
547   :type '(repeat (string))
548   :group 'nnir)
549
550 (defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
551   "*The prefix to remove from each file name returned by swish-e
552 in order to get a group name (albeit with / instead of .).  This is a
553 regular expression.
554
555 This variable is very similar to `nnir-wais-remove-prefix', except
556 that it is for swish-e, not Wais.
557
558 This could be a server parameter."
559   :type '(regexp)
560   :group 'nnir)
561
562 ;; Namazu engine, see <URL:http://www.namazu.org/>
563
564 (defcustom nnir-namazu-program "namazu"
565   "*Name of Namazu search executable."
566   :type '(string)
567   :group 'nnir)
568
569 (defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/")
570   "*Index directory for Namazu."
571   :type '(directory)
572   :group 'nnir)
573
574 (defcustom nnir-namazu-additional-switches '()
575   "*A list of strings, to be given as additional arguments to namazu.
576 The switches `-q', `-a', and `-s' are always used, very few other switches
577 make any sense in this context.
578
579 Note that this should be a list.  Ie, do NOT use the following:
580     (setq nnir-namazu-additional-switches \"-i -w\") ; wrong
581 Instead, use this:
582     (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
583   :type '(repeat (string))
584   :group 'nnir)
585
586 (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
587   "*The prefix to remove from each file name returned by Namazu
588 in order to get a group name (albeit with / instead of .).
589
590 This variable is very similar to `nnir-wais-remove-prefix', except
591 that it is for Namazu, not Wais."
592   :type '(directory)
593   :group 'nnir)
594
595 ;;; Internal Variables:
596
597 (defvar nnir-current-query nil
598   "Internal: stores current query (= group name).")
599
600 (defvar nnir-current-server nil
601   "Internal: stores current server (does it ever change?).")
602
603 (defvar nnir-current-group-marked nil
604   "Internal: stores current list of process-marked groups.")
605
606 (defvar nnir-artlist nil
607   "Internal: stores search result.")
608
609 (defvar nnir-tmp-buffer " *nnir*"
610   "Internal: temporary buffer.")
611
612 ;;; Code:
613
614 ;; Gnus glue.
615
616 (defun gnus-group-make-nnir-group (extra-parms query)
617   "Create an nnir group.  Asks for query."
618   (interactive "P\nsQuery: ")
619   (setq nnir-current-query nil
620         nnir-current-server nil
621         nnir-current-group-marked nil
622         nnir-artlist nil)
623   (let ((parms nil))
624     (if extra-parms
625         (setq parms (nnir-read-parms query))
626       (setq parms (list (cons 'query query))))
627     (add-to-list 'parms (cons 'unique-id (message-unique-id)) t)
628     (gnus-group-read-ephemeral-group
629      (concat "nnir:" (prin1-to-string parms)) '(nnir "") t
630      (cons (current-buffer)
631            gnus-current-window-configuration)
632      nil)))
633
634 ;; Why is this needed? Is this for compatibility with old/new gnusae? Using
635 ;; gnus-group-server instead works for me.  -- Justus Piater
636 (defmacro nnir-group-server (group)
637   "Return the server for a newsgroup GROUP.
638 The returned format is as `gnus-server-to-method' needs it.  See
639 `gnus-group-real-prefix' and `gnus-group-real-name'."
640   `(let ((gname ,group))
641      (if (string-match "^\\([^:]+\\):" gname)
642          (progn
643            (setq gname (match-string 1 gname))
644            (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname)
645                (format "%s:%s" (match-string 1 gname) (match-string 2 gname))
646              (concat gname ":")))
647        (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method)))))
648
649 ;; Summary mode commands.
650
651 (defun gnus-summary-nnir-goto-thread ()
652   "Only applies to nnir groups.  Go to group this article came from
653 and show thread that contains this article."
654   (interactive)
655   (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
656     (error "Can't execute this command unless in nnir group"))
657   (let* ((cur (gnus-summary-article-number))
658          (group (nnir-artlist-artitem-group nnir-artlist cur))
659          (backend-number (nnir-artlist-artitem-number nnir-artlist cur))
660          (id (mail-header-id (gnus-summary-article-header)))
661          (refs (split-string
662                 (mail-header-references (gnus-summary-article-header)))))
663     (if (eq (car (gnus-group-method group)) 'nnimap)
664         (progn (nnimap-possibly-change-group (gnus-group-short-name group) nil)
665                (with-current-buffer (nnimap-buffer)
666                  (let* ((cmd (let ((value (format
667                                            "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
668                                            id id)))
669                                (dolist (refid refs value)
670                                  (setq value (format
671                                               "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
672                                               refid refid value)))))
673                         (result (nnimap-command
674                                  "UID SEARCH %s" cmd)))
675                    (gnus-summary-read-group-1 group t t gnus-summary-buffer nil
676                                               (and (car result)
677                                                    (delete 0 (mapcar #'string-to-number
678                                                                      (cdr (assoc "SEARCH" (cdr result))))))))))
679       (gnus-summary-read-group-1 group t t gnus-summary-buffer
680                                  nil (list backend-number))
681       (gnus-summary-limit (list backend-number))
682       (gnus-summary-refer-thread))))
683
684
685 (if (fboundp 'eval-after-load)
686     (eval-after-load "gnus-sum"
687       '(define-key gnus-summary-goto-map
688          "T" 'gnus-summary-nnir-goto-thread))
689   (add-hook 'gnus-summary-mode-hook
690             (function (lambda ()
691                         (define-key gnus-summary-goto-map
692                           "T" 'gnus-summary-nnir-goto-thread)))))
693
694
695
696 ;; Gnus backend interface functions.
697
698 (deffoo nnir-open-server (server &optional definitions)
699   ;; Just set the server variables appropriately.
700   (nnoo-change-server 'nnir server definitions))
701
702 (deffoo nnir-request-group (group &optional server fast info)
703   "GROUP is the query string."
704   (nnir-possibly-change-server server)
705   ;; Check for cache and return that if appropriate.
706   (if (and (equal group nnir-current-query)
707            (equal gnus-group-marked nnir-current-group-marked)
708            (or (null server)
709                (equal server nnir-current-server)))
710       nnir-artlist
711     ;; Cache miss.
712     (setq nnir-artlist (nnir-run-query group)))
713   (with-current-buffer nntp-server-buffer
714     (if (zerop (length nnir-artlist))
715         (progn
716           (setq nnir-current-query nil
717                 nnir-current-server nil
718                 nnir-current-group-marked nil
719                 nnir-artlist nil)
720           (nnheader-report 'nnir "Search produced empty results."))
721       ;; Remember data for cache.
722       (setq nnir-current-query group)
723       (when server (setq nnir-current-server server))
724       (setq nnir-current-group-marked gnus-group-marked)
725       (nnheader-insert "211 %d %d %d %s\n"
726                        (nnir-artlist-length nnir-artlist) ; total #
727                        1              ; first #
728                        (nnir-artlist-length nnir-artlist) ; last #
729                        group))))     ; group name
730
731 (deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
732   (save-excursion
733     (let ((artlist (copy-sequence articles))
734           art artitem artgroup artno artrsv artfullgroup
735           novitem novdata foo server)
736       (while (not (null artlist))
737         (setq art (car artlist))
738         (or (numberp art)
739             (nnheader-report
740              'nnir
741              "nnir-retrieve-headers doesn't grok message ids: %s"
742              art))
743         (setq artitem (nnir-artlist-article nnir-artlist art))
744         (setq artrsv (nnir-artitem-rsv artitem))
745         (setq artfullgroup (nnir-artitem-group artitem))
746         (setq artno (nnir-artitem-number artitem))
747         (setq artgroup (gnus-group-real-name artfullgroup))
748         (setq server (nnir-group-server artfullgroup))
749         ;; retrieve NOV or HEAD data for this article, transform into
750         ;; NOV data and prepend to `novdata'
751         (set-buffer nntp-server-buffer)
752         (nnir-possibly-change-server server)
753         (let ((gnus-override-method
754                (gnus-server-to-method server)))
755           ;; if nnir-get-article-nov-override-function is set, use it
756           (if nnir-get-article-nov-override-function
757               (setq novitem (funcall nnir-get-article-nov-override-function
758                                      artitem))
759             ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
760             (case (setq foo (gnus-retrieve-headers (list artno)
761                                                    artfullgroup nil))
762               (nov
763                (goto-char (point-min))
764                (setq novitem (nnheader-parse-nov)))
765               (headers
766                (goto-char (point-min))
767                (setq novitem (nnheader-parse-head)))
768               (t (error "Unknown header type %s while requesting article %s of group %s"
769                         foo artno artfullgroup)))))
770         ;; replace article number in original group with article number
771         ;; in nnir group
772         (when novitem
773           (mail-header-set-number novitem art)
774           (mail-header-set-from novitem
775                                 (mail-header-from novitem))
776           (mail-header-set-subject
777            novitem
778            (format "[%d: %s/%d] %s"
779                    artrsv artgroup artno
780                    (mail-header-subject novitem)))
781           (push novitem novdata)
782           (setq artlist (cdr artlist))))
783       (setq novdata (nreverse novdata))
784       (set-buffer nntp-server-buffer) (erase-buffer)
785       (mapc 'nnheader-insert-nov novdata)
786       'nov)))
787
788 (deffoo nnir-request-article (article
789                               &optional group server to-buffer)
790   (if (stringp article)
791       (nnheader-report
792        'nnir
793        "nnir-retrieve-headers doesn't grok message ids: %s"
794        article)
795     (save-excursion
796       (let* ((artitem (nnir-artlist-article nnir-artlist
797                                             article))
798              (artfullgroup (nnir-artitem-group artitem))
799              (artno (nnir-artitem-number artitem))
800              ;; Bug?
801              ;; Why must we bind nntp-server-buffer here?  It won't
802              ;; work if `buf' is used, say.  (Of course, the set-buffer
803              ;; line below must then be updated, too.)
804              (nntp-server-buffer (or to-buffer nntp-server-buffer)))
805         (set-buffer nntp-server-buffer)
806         (erase-buffer)
807         (message "Requesting article %d from group %s"
808                  artno artfullgroup)
809         (gnus-request-article artno artfullgroup nntp-server-buffer)
810         (cons artfullgroup artno)))))
811
812
813 (nnoo-define-skeleton nnir)
814
815
816 (defmacro nnir-add-result (dirnam artno score prefix server artlist)
817   "Ask `nnir-compose-result' to construct a result vector,
818 and if it is non-nil, add it to artlist."
819   `(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server)))
820      (when (not (null result))
821        (push result ,artlist))))
822
823 (autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
824
825 ;; Helper function currently used by the Swish++ and Namazu backends;
826 ;; perhaps useful for other backends as well
827 (defun nnir-compose-result (dirnam article score prefix server)
828   "Extract the group from dirnam, and create a result vector
829 ready to be added to the list of search results."
830
831   ;; remove nnir-*-remove-prefix from beginning of dirnam filename
832   (when (string-match (concat "^" prefix) dirnam)
833     (setq dirnam (replace-match "" t t dirnam)))
834
835   (when (file-readable-p (concat prefix dirnam article))
836     ;; remove trailing slash and, for nnmaildir, cur/new/tmp
837     (setq dirnam
838           (substring dirnam 0
839                      (if (string= (gnus-group-server server) "nnmaildir")
840                          -5 -1)))
841
842     ;; Set group to dirnam without any leading dots or slashes,
843     ;; and with all subsequent slashes replaced by dots
844     (let ((group (gnus-replace-in-string
845                  (gnus-replace-in-string dirnam "^[./\\]" "" t)
846                  "[/\\]" "." t)))
847
848     (vector (nnir-group-full-name group server)
849             (if (string= (gnus-group-server server) "nnmaildir")
850                 (nnmaildir-base-name-to-article-number
851                  (substring article 0 (string-match ":" article))
852                  group nil)
853               (string-to-number article))
854             (string-to-number score)))))
855
856 ;;; Search Engine Interfaces:
857
858 ;; freeWAIS-sf interface.
859 (defun nnir-run-waissearch (query server &optional group)
860   "Run given query agains waissearch.  Returns vector of (group name, file name)
861 pairs (also vectors, actually)."
862   (when group
863     (error "The freeWAIS-sf backend cannot search specific groups"))
864   (save-excursion
865     (let ((qstring (cdr (assq 'query query)))
866           (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server))
867           artlist score artno dirnam)
868       (set-buffer (get-buffer-create nnir-tmp-buffer))
869       (erase-buffer)
870       (message "Doing WAIS query %s..." query)
871       (call-process nnir-wais-program
872                     nil                 ; input from /dev/null
873                     t                   ; output to current buffer
874                     nil                 ; don't redisplay
875                     "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search
876                     qstring)
877       (message "Massaging waissearch output...")
878       ;; remove superfluous lines
879       (keep-lines "Score:")
880       ;; extract data from result lines
881       (goto-char (point-min))
882       (while (re-search-forward
883               "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t)
884         (setq score (match-string 1)
885               artno (match-string 2)
886               dirnam (match-string 3))
887         (unless (string-match prefix dirnam)
888           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
889                            dirnam prefix))
890         (setq group (gnus-replace-in-string
891                      (replace-match "" t t dirnam) "/" "."))
892         (push (vector (nnir-group-full-name group server)
893                       (string-to-number artno)
894                       (string-to-number score))
895               artlist))
896       (message "Massaging waissearch output...done")
897       (apply 'vector
898              (sort artlist
899                    (function (lambda (x y)
900                                (> (nnir-artitem-rsv x)
901                                   (nnir-artitem-rsv y)))))))))
902
903 ;; IMAP interface.
904 ;; todo:
905 ;; send queries as literals
906 ;; handle errors
907
908
909 (defun nnir-run-imap (query srv &optional group-option)
910   "Run a search against an IMAP back-end server.
911 This uses a custom query language parser; see `nnir-imap-make-query' for
912 details on the language and supported extensions"
913   (save-excursion
914     (let ((qstring (cdr (assq 'query query)))
915           (server (cadr (gnus-server-to-method srv)))
916           (group (or group-option (gnus-group-group-name)))
917           (defs (caddr (gnus-server-to-method srv)))
918           (criteria (or (cdr (assq 'criteria query))
919                         (cdr (assoc nnir-imap-default-search-key
920                                     nnir-imap-search-arguments))))
921           (gnus-inhibit-demon t)
922           artlist)
923       (message "Opening server %s" server)
924       (condition-case ()
925           (when (nnimap-possibly-change-group (gnus-group-short-name group) server)
926             (with-current-buffer (nnimap-buffer)
927               (message "Searching %s..." group)
928               (let ((arts 0)
929                     (result
930                      (nnimap-command "UID SEARCH %s"
931                                      (if (string= criteria "")
932                                          qstring
933                                        (nnir-imap-make-query criteria qstring)
934                                        ))))
935                 (mapc
936                  (lambda (artnum)
937                    (push (vector group artnum 1) artlist)
938                    (setq arts (1+ arts)))
939                  (and (car result)
940                       (delete 0 (mapcar #'string-to-number
941                                         (cdr (assoc "SEARCH" (cdr result)))))))
942                 (message "Searching %s... %d matches" group arts)))
943             (message "Searching %s...done" group))
944         (quit nil))
945       (reverse artlist))))
946
947 (defun nnir-imap-make-query (criteria qstring)
948   "Parse the query string and criteria into an appropriate IMAP search
949 expression, returning the string query to make.
950
951 This implements a little language designed to return the expected results
952 to an arbitrary query string to the end user.
953
954 The search is always case-insensitive, as defined by RFC2060, and supports
955 the following features (inspired by the Google search input language):
956
957 Automatic \"and\" queries
958     If you specify multiple words then they will be treated as an \"and\"
959     expression intended to match all components.
960
961 Phrase searches
962     If you wrap your query in double-quotes then it will be treated as a
963     literal string.
964
965 Negative terms
966     If you precede a term with \"-\" then it will negate that.
967
968 \"OR\" queries
969     If you include an upper-case \"OR\" in your search it will cause the
970     term before it and the term after it to be treated as alternatives.
971
972 In future the following will be added to the language:
973  * support for date matches
974  * support for location of text matching within the query
975  * from/to/etc headers
976  * additional search terms
977  * flag based searching
978  * anything else that the RFC supports, basically."
979   ;; Walk through the query and turn it into an IMAP query string.
980   (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring)))
981
982
983 (defun nnir-imap-query-to-imap (criteria query)
984   "Turn a s-expression format query into IMAP."
985   (mapconcat
986    ;; Turn the expressions into IMAP text
987    (lambda (item)
988      (nnir-imap-expr-to-imap criteria item))
989    ;; The query, already in s-expr format.
990    query
991    ;; Append a space between each expression
992    " "))
993
994
995 (defun nnir-imap-expr-to-imap (criteria expr)
996   "Convert EXPR into an IMAP search expression on CRITERIA"
997   ;; What sort of expression is this, eh?
998   (cond
999    ;; Simple string term
1000    ((stringp expr)
1001     (format "%s %S" criteria expr))
1002    ;; Trivial term: and
1003    ((eq expr 'and) nil)
1004    ;; Composite term: or expression
1005    ((eq (car-safe expr) 'or)
1006     (format "OR %s %s"
1007             (nnir-imap-expr-to-imap criteria (second expr))
1008             (nnir-imap-expr-to-imap criteria (third expr))))
1009    ;; Composite term: just the fax, mam
1010    ((eq (car-safe expr) 'not)
1011     (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
1012    ;; Composite term: just expand it all.
1013    ((and (not (null expr)) (listp expr))
1014     (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
1015    ;; Complex value, give up for now.
1016    (t (error "Unhandled input: %S" expr))))
1017
1018
1019 (defun nnir-imap-parse-query (string)
1020   "Turn STRING into an s-expression based query based on the IMAP
1021 query language as defined in `nnir-imap-make-query'.
1022
1023 This involves turning individual tokens into higher level terms
1024 that the search language can then understand and use."
1025   (with-temp-buffer
1026     ;; Set up the parsing environment.
1027     (insert string)
1028     (goto-char (point-min))
1029     ;; Now, collect the output terms and return them.
1030     (let (out)
1031       (while (not (nnir-imap-end-of-input))
1032         (push (nnir-imap-next-expr) out))
1033       (reverse out))))
1034
1035
1036 (defun nnir-imap-next-expr (&optional count)
1037   "Return the next expression from the current buffer."
1038   (let ((term (nnir-imap-next-term count))
1039         (next (nnir-imap-peek-symbol)))
1040     ;; Are we looking at an 'or' expression?
1041     (cond
1042      ;; Handle 'expr or expr'
1043      ((eq next 'or)
1044       (list 'or term (nnir-imap-next-expr 2)))
1045      ;; Anything else
1046      (t term))))
1047
1048
1049 (defun nnir-imap-next-term (&optional count)
1050   "Return the next TERM from the current buffer."
1051   (let ((term (nnir-imap-next-symbol count)))
1052     ;; What sort of term is this?
1053     (cond
1054      ;; and -- just ignore it
1055      ((eq term 'and) 'and)
1056      ;; negated term
1057      ((eq term 'not) (list 'not (nnir-imap-next-expr)))
1058      ;; generic term
1059      (t term))))
1060
1061
1062 (defun nnir-imap-peek-symbol ()
1063   "Return the next symbol from the current buffer, but don't consume it."
1064   (save-excursion
1065     (nnir-imap-next-symbol)))
1066
1067 (defun nnir-imap-next-symbol (&optional count)
1068   "Return the next symbol from the current buffer, or nil if we are
1069 at the end of the buffer.  If supplied COUNT skips some symbols before
1070 returning the one at the supplied position."
1071   (when (and (numberp count) (> count 1))
1072     (nnir-imap-next-symbol (1- count)))
1073   (let ((case-fold-search t))
1074     ;; end of input stream?
1075     (unless (nnir-imap-end-of-input)
1076       ;; No, return the next symbol from the stream.
1077       (cond
1078        ;; negated expression -- return it and advance one char.
1079        ((looking-at "-") (forward-char 1) 'not)
1080        ;; quoted string
1081        ((looking-at "\"") (nnir-imap-delimited-string "\""))
1082        ;; list expression -- we parse the content and return this as a list.
1083        ((looking-at "(")
1084         (nnir-imap-parse-query (nnir-imap-delimited-string ")")))
1085        ;; keyword input -- return a symbol version
1086        ((looking-at "\\band\\b") (forward-char 3) 'and)
1087        ((looking-at "\\bor\\b")  (forward-char 2) 'or)
1088        ((looking-at "\\bnot\\b") (forward-char 3) 'not)
1089        ;; Simple, boring keyword
1090        (t (let ((start (point))
1091                 (end (if (search-forward-regexp "[[:blank:]]" nil t)
1092                          (prog1
1093                              (match-beginning 0)
1094                            ;; unskip if we hit a non-blank terminal character.
1095                            (when (string-match "[^[:blank:]]" (match-string 0))
1096                              (backward-char 1)))
1097                        (goto-char (point-max)))))
1098             (buffer-substring start end)))))))
1099
1100 (defun nnir-imap-delimited-string (delimiter)
1101   "Return a delimited string from the current buffer."
1102   (let ((start (point)) end)
1103     (forward-char 1)                    ; skip the first delimiter.
1104     (while (not end)
1105       (unless (search-forward delimiter nil t)
1106         (error "Unmatched delimited input with %s in query" delimiter))
1107       (let ((here (point)))
1108         (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
1109           (setq end (point)))))
1110     (buffer-substring (1+ start) (1- end))))
1111
1112 (defun nnir-imap-end-of-input ()
1113   "Are we at the end of input?"
1114   (skip-chars-forward "[[:blank:]]")
1115   (looking-at "$"))
1116
1117
1118 ;; Swish++ interface.
1119 ;; -cc- Todo
1120 ;; Search by
1121 ;; - group
1122 ;; Sort by
1123 ;; - rank (default)
1124 ;; - article number
1125 ;; - file size
1126 ;; - group
1127 (defun nnir-run-swish++ (query server &optional group)
1128   "Run QUERY against swish++.
1129 Returns a vector of (group name, file name) pairs (also vectors,
1130 actually).
1131
1132 Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on
1133 Windows NT 4.0."
1134
1135   (when group
1136     (error "The swish++ backend cannot search specific groups"))
1137
1138   (save-excursion
1139     (let ( (qstring (cdr (assq 'query query)))
1140            (groupspec (cdr (assq 'group query)))
1141            (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server))
1142            artlist
1143            ;; nnml-use-compressed-files might be any string, but probably this
1144            ;; is sufficient.  Note that we can't only use the value of
1145            ;; nnml-use-compressed-files because old articles might have been
1146            ;; saved with a different value.
1147            (article-pattern (if (string= (gnus-group-server server) "nnmaildir")
1148                                 ":[0-9]+"
1149                               "^[0-9]+\\(\\.[a-z0-9]+\\)?$"))
1150            score artno dirnam filenam)
1151
1152       (when (equal "" qstring)
1153         (error "swish++: You didn't enter anything"))
1154
1155       (set-buffer (get-buffer-create nnir-tmp-buffer))
1156       (erase-buffer)
1157
1158       (if groupspec
1159           (message "Doing swish++ query %s on %s..." qstring groupspec)
1160         (message "Doing swish++ query %s..." qstring))
1161
1162       (let* ((cp-list `( ,nnir-swish++-program
1163                          nil            ; input from /dev/null
1164                          t              ; output
1165                          nil            ; don't redisplay
1166                          "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server)
1167                          ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server)
1168                          ,qstring       ; the query, in swish++ format
1169                          ))
1170              (exitstatus
1171               (progn
1172                 (message "%s args: %s" nnir-swish++-program
1173                          (mapconcat 'identity (cddddr cp-list) " ")) ;; ???
1174                 (apply 'call-process cp-list))))
1175         (unless (or (null exitstatus)
1176                     (zerop exitstatus))
1177           (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus)
1178           ;; swish++ failure reason is in this buffer, show it if
1179           ;; the user wants it.
1180           (when (> gnus-verbose 6)
1181             (display-buffer nnir-tmp-buffer))))
1182
1183       ;; The results are output in the format of:
1184       ;; V 4.7 Linux
1185       ;; rank relative-path-name file-size file-title
1186       ;; V 5.0b2:
1187       ;; rank relative-path-name file-size topic??
1188       ;; where rank is an integer from 1 to 100.
1189       (goto-char (point-min))
1190       (while (re-search-forward
1191               "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
1192         (setq score (match-string 1)
1193               filenam (match-string 2)
1194               artno (file-name-nondirectory filenam)
1195               dirnam (file-name-directory filenam))
1196
1197         ;; don't match directories
1198         (when (string-match article-pattern artno)
1199           (when (not (null dirnam))
1200
1201             ;; maybe limit results to matching groups.
1202             (when (or (not groupspec)
1203                       (string-match groupspec dirnam))
1204               (nnir-add-result dirnam artno score prefix server artlist)))))
1205
1206       (message "Massaging swish++ output...done")
1207
1208       ;; Sort by score
1209       (apply 'vector
1210              (sort artlist
1211                    (function (lambda (x y)
1212                                (> (nnir-artitem-rsv x)
1213                                   (nnir-artitem-rsv y)))))))))
1214
1215 ;; Swish-E interface.
1216 (defun nnir-run-swish-e (query server &optional group)
1217   "Run given query against swish-e.
1218 Returns a vector of (group name, file name) pairs (also vectors,
1219 actually).
1220
1221 Tested with swish-e-2.0.1 on Windows NT 4.0."
1222
1223   ;; swish-e crashes with empty parameter to "-w" on commandline...
1224   (when group
1225     (error "The swish-e backend cannot search specific groups"))
1226
1227   (save-excursion
1228     (let ((qstring (cdr (assq 'query query)))
1229           (prefix
1230            (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server)
1231                (error "Missing parameter `nnir-swish-e-remove-prefix'")))
1232           artlist score artno dirnam group )
1233
1234       (when (equal "" qstring)
1235         (error "swish-e: You didn't enter anything"))
1236
1237       (set-buffer (get-buffer-create nnir-tmp-buffer))
1238       (erase-buffer)
1239
1240       (message "Doing swish-e query %s..." query)
1241       (let* ((index-files
1242               (or (nnir-read-server-parm
1243                    'nnir-swish-e-index-files server)
1244                   (error "Missing parameter `nnir-swish-e-index-files'")))
1245              (additional-switches
1246               (nnir-read-server-parm
1247                'nnir-swish-e-additional-switches server))
1248              (cp-list `(,nnir-swish-e-program
1249                         nil             ; input from /dev/null
1250                         t               ; output
1251                         nil             ; don't redisplay
1252                         "-f" ,@index-files
1253                         ,@additional-switches
1254                         "-w"
1255                         ,qstring        ; the query, in swish-e format
1256                         ))
1257              (exitstatus
1258               (progn
1259                 (message "%s args: %s" nnir-swish-e-program
1260                          (mapconcat 'identity (cddddr cp-list) " "))
1261                 (apply 'call-process cp-list))))
1262         (unless (or (null exitstatus)
1263                     (zerop exitstatus))
1264           (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus)
1265           ;; swish-e failure reason is in this buffer, show it if
1266           ;; the user wants it.
1267           (when (> gnus-verbose 6)
1268             (display-buffer nnir-tmp-buffer))))
1269
1270       ;; The results are output in the format of:
1271       ;; rank path-name file-title file-size
1272       (goto-char (point-min))
1273       (while (re-search-forward
1274               "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
1275         (setq score (match-string 1)
1276               artno (match-string 3)
1277               dirnam (file-name-directory (match-string 2)))
1278
1279         ;; don't match directories
1280         (when (string-match "^[0-9]+$" artno)
1281           (when (not (null dirnam))
1282
1283             ;; remove nnir-swish-e-remove-prefix from beginning of dirname
1284             (when (string-match (concat "^" prefix) dirnam)
1285               (setq dirnam (replace-match "" t t dirnam)))
1286
1287             (setq dirnam (substring dirnam 0 -1))
1288             ;; eliminate all ".", "/", "\" from beginning. Always matches.
1289             (string-match "^[./\\]*\\(.*\\)$" dirnam)
1290             ;; "/" -> "."
1291             (setq group (gnus-replace-in-string (match-string 1 dirnam) "/" "."))
1292             ;; Windows "\\" -> "."
1293             (setq group (gnus-replace-in-string group "\\\\" "."))
1294
1295             (push (vector (nnir-group-full-name group server)
1296                           (string-to-number artno)
1297                           (string-to-number score))
1298                   artlist))))
1299
1300       (message "Massaging swish-e output...done")
1301
1302       ;; Sort by score
1303       (apply 'vector
1304              (sort artlist
1305                    (function (lambda (x y)
1306                                (> (nnir-artitem-rsv x)
1307                                   (nnir-artitem-rsv y)))))))))
1308
1309 ;; Namazu interface
1310 (defun nnir-run-namazu (query server &optional group)
1311   "Run given query against Namazu.  Returns a vector of (group name, file name)
1312 pairs (also vectors, actually).
1313
1314 Tested with Namazu 2.0.6 on a GNU/Linux system."
1315   (when group
1316     (error "The Namazu backend cannot search specific groups"))
1317   (save-excursion
1318     (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir")
1319                                ":[0-9]+"
1320                              "^[0-9]+$"))
1321           artlist
1322           (qstring (cdr (assq 'query query)))
1323           (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server))
1324           score group article
1325           (process-environment (copy-sequence process-environment)))
1326       (setenv "LC_MESSAGES" "C")
1327       (set-buffer (get-buffer-create nnir-tmp-buffer))
1328       (erase-buffer)
1329       (let* ((cp-list
1330               `( ,nnir-namazu-program
1331                  nil                    ; input from /dev/null
1332                  t                      ; output
1333                  nil                    ; don't redisplay
1334                  "-q"                   ; don't be verbose
1335                  "-a"                   ; show all matches
1336                  "-s"                   ; use short format
1337                  ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server)
1338                  ,qstring               ; the query, in namazu format
1339                  ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory
1340                  ))
1341              (exitstatus
1342               (progn
1343                 (message "%s args: %s" nnir-namazu-program
1344                          (mapconcat 'identity (cddddr cp-list) " "))
1345                 (apply 'call-process cp-list))))
1346         (unless (or (null exitstatus)
1347                     (zerop exitstatus))
1348           (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus)
1349           ;; Namazu failure reason is in this buffer, show it if
1350           ;; the user wants it.
1351           (when (> gnus-verbose 6)
1352             (display-buffer nnir-tmp-buffer))))
1353
1354       ;; Namazu output looks something like this:
1355       ;; 2. Re: Gnus agent expire broken (score: 55)
1356       ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes)
1357
1358       (goto-char (point-min))
1359       (while (re-search-forward
1360               "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
1361               nil t)
1362         (setq score (match-string 3)
1363               group (file-name-directory (match-string 4))
1364               article (file-name-nondirectory (match-string 4)))
1365
1366         ;; make sure article and group is sane
1367         (when (and (string-match article-pattern article)
1368                    (not (null group)))
1369           (nnir-add-result group article score prefix server artlist)))
1370
1371       ;; sort artlist by score
1372       (apply 'vector
1373              (sort artlist
1374                    (function (lambda (x y)
1375                                (> (nnir-artitem-rsv x)
1376                                   (nnir-artitem-rsv y)))))))))
1377
1378 (defun nnir-run-find-grep (query server &optional group)
1379   "Run find and grep to obtain matching articles."
1380   (let* ((method (gnus-server-to-method server))
1381          (sym (intern
1382                (concat (symbol-name (car method)) "-directory")))
1383          (directory (cadr (assoc sym (cddr method))))
1384          (regexp (cdr (assoc 'query query)))
1385          (grep-options (cdr (assoc 'grep-options query)))
1386          artlist)
1387     (unless directory
1388       (error "No directory found in method specification of server %s"
1389              server))
1390     (message "Searching %s using find-grep..." (or group server))
1391     (save-window-excursion
1392       (set-buffer (get-buffer-create nnir-tmp-buffer))
1393       (erase-buffer)
1394       (if (> gnus-verbose 6)
1395           (pop-to-buffer (current-buffer)))
1396       (cd directory) ; Using relative paths simplifies postprocessing.
1397       (let ((group
1398              (if (not group)
1399                  "."
1400                ;; Try accessing the group literally as well as
1401                ;; interpreting dots as directory separators so the
1402                ;; engine works with plain nnml as well as the Gnus Cache.
1403                (let ((group (gnus-group-real-name group)))
1404                  ;; Replace cl-func find-if.
1405                  (if (file-directory-p group)
1406                      group
1407                    (if (file-directory-p
1408                         (setq group (gnus-replace-in-string group "\\." "/" t)))
1409                        group))))))
1410         (unless group
1411           (error "Cannot locate directory for group"))
1412         (save-excursion
1413           (apply
1414            'call-process "find" nil t
1415            "find" group "-type" "f" "-name" "[0-9]*" "-exec"
1416            "grep"
1417            `("-l" ,@(and grep-options
1418                          (split-string grep-options "\\s-" t))
1419              "-e" ,regexp "{}" "+"))))
1420
1421       ;; Translate relative paths to group names.
1422       (while (not (eobp))
1423         (let* ((path (split-string
1424                       (buffer-substring (point) (line-end-position)) "/" t))
1425                (art (string-to-number (car (last path)))))
1426           (while (string= "." (car path))
1427             (setq path (cdr path)))
1428           (let ((group (mapconcat 'identity
1429                                   ;; Replace cl-func: (subseq path 0 -1)
1430                                   (let ((end (1- (length path)))
1431                                         res)
1432                                     (while (>= (setq end (1- end)) 0)
1433                                       (push (pop path) res))
1434                                     (nreverse res))
1435                                   ".")))
1436             (push (vector (nnir-group-full-name group server) art 0)
1437                   artlist))
1438           (forward-line 1)))
1439       (message "Searching %s using find-grep...done" (or group server))
1440       artlist)))
1441
1442 ;;; Util Code:
1443
1444 (defun nnir-read-parms (query)
1445   "Reads additional search parameters according to `nnir-engines'."
1446   (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
1447     (cons (cons 'query query)
1448           (mapcar 'nnir-read-parm parmspec))))
1449
1450 (defun nnir-read-parm (parmspec)
1451   "Reads a single search parameter.
1452 `parmspec' is a cons cell, the car is a symbol, the cdr is a prompt."
1453   (let ((sym (car parmspec))
1454         (prompt (cdr parmspec)))
1455     (if (listp prompt)
1456         (let* ((result (apply 'gnus-completing-read prompt))
1457                (mapping (or (assoc result nnir-imap-search-arguments)
1458                             (cons nil nnir-imap-search-other))))
1459           (cons sym (format (cdr mapping) result)))
1460       (cons sym (read-string prompt)))))
1461
1462 (defun nnir-run-query (query)
1463   "Invoke appropriate search engine function (see `nnir-engines').
1464 If some groups were process-marked, run the query for each of the groups
1465 and concat the results."
1466   (let ((q (car (read-from-string query))))
1467     (if gnus-group-marked
1468         (apply 'vconcat
1469                (mapcar (lambda (x)
1470                          (let* ((server (nnir-group-server x))
1471                                 (engine
1472                                  (or (nnir-read-server-parm 'nnir-search-engine
1473                                                             server)
1474                                      (cdr
1475                                       (assoc (car (gnus-server-to-method server))
1476                                              nnir-method-default-engines))))
1477                                 search-func)
1478                            (setq search-func (cadr
1479                                               (assoc
1480                                                engine
1481                                                nnir-engines)))
1482                            (if search-func
1483                                (funcall search-func q server x)
1484                              nil)))
1485                        gnus-group-marked))
1486       (apply 'vconcat
1487              (mapcar (lambda (x)
1488                        (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral")))
1489                            (let* ((server (format "%s:%s" (caar x) (cadar x)))
1490                                   (engine
1491                                    (or (nnir-read-server-parm 'nnir-search-engine
1492                                                               server)
1493                                        (cdr
1494                                         (assoc (car (gnus-server-to-method server))
1495                                                nnir-method-default-engines))))
1496                                   search-func)
1497                              (setq search-func (cadr
1498                                                 (assoc
1499                                                  engine
1500                                                  nnir-engines)))
1501                              (if search-func
1502                                  (funcall search-func q server nil)
1503                                nil))
1504                          nil))
1505                      gnus-opened-servers)
1506              ))
1507     ))
1508
1509 (defun nnir-read-server-parm (key server)
1510   "Returns the parameter value of for the given server, where server is of
1511 form 'backend:name'."
1512   (let ((method (gnus-server-to-method server)))
1513     (cond ((and method (assq key (cddr method)))
1514            (nth 1 (assq key (cddr method))))
1515           ((and nnir-mail-backend
1516                 (gnus-server-equal method nnir-mail-backend))
1517            (symbol-value key))
1518           (t nil))))
1519 ;;     (if method
1520 ;;       (if (assq key (cddr method))
1521 ;;        (nth 1 (assq key (cddr method)))
1522 ;;      (symbol-value key))
1523 ;;       (symbol-value key))
1524 ;;     ))
1525
1526 (defun nnir-group-full-name (shortname server)
1527   "For the given group name, return a full Gnus group name.
1528 The Gnus backend/server information is added."
1529   (gnus-group-prefixed-name shortname (gnus-server-to-method server)))
1530
1531 (defun nnir-possibly-change-server (server)
1532   (unless (and server (nnir-server-opened server))
1533     (nnir-open-server server)))
1534
1535
1536 ;; Data type article list.
1537
1538 (defun nnir-artlist-length (artlist)
1539   "Returns number of articles in artlist."
1540   (length artlist))
1541
1542 (defun nnir-artlist-article (artlist n)
1543   "Returns from ARTLIST the Nth artitem (counting starting at 1)."
1544   (elt artlist (1- n)))
1545
1546 (defun nnir-artitem-group (artitem)
1547   "Returns the group from the ARTITEM."
1548   (elt artitem 0))
1549
1550 (defun nnir-artlist-artitem-group (artlist n)
1551   "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
1552   (nnir-artitem-group (nnir-artlist-article artlist n)))
1553
1554 (defun nnir-artitem-number (artitem)
1555   "Returns the number from the ARTITEM."
1556   (elt artitem 1))
1557
1558 (defun nnir-artlist-artitem-number (artlist n)
1559   "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
1560   (nnir-artitem-number (nnir-artlist-article artlist n)))
1561
1562 (defun nnir-artitem-rsv (artitem)
1563   "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
1564   (elt artitem 2))
1565
1566 (defun nnir-artlist-artitem-rsv (artlist n)
1567   "Returns from ARTLIST the Retrieval Status Value of the Nth artitem
1568 \(counting from 1)."
1569   (nnir-artitem-rsv (nnir-artlist-article artlist n)))
1570
1571 ;; unused?
1572 (defun nnir-artlist-groups (artlist)
1573   "Returns a list of all groups in the given ARTLIST."
1574   (let ((res nil)
1575         (with-dups nil))
1576     ;; from each artitem, extract group component
1577     (setq with-dups (mapcar 'nnir-artitem-group artlist))
1578     ;; remove duplicates from above
1579     (mapc (function (lambda (x) (add-to-list 'res x)))
1580             with-dups)
1581     res))
1582
1583
1584 ;; The end.
1585 (provide 'nnir)
1586
1587 ;;; nnir.el ends here