cgit.sxemacs.org Git - gnus/blob - lisp/nnir.el

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