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