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-article RET) on an article.  You
  45 ;; will be warped into the group this article came from. Typing `A W'
  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-get-article-nov-override-function nil
 427   "If non-nil, a function that will be passed each search result.  This
 428 should return a message's headers in NOV format.
 429
 430 If this variable is nil, or if the provided function returns nil for a search
 431 result, `gnus-retrieve-headers' will be called instead.")
 432
 433 ;;; Internal Variables:
 434
 435 (defvar nnir-current-query nil
 436   "Internal: stores current query (= group name).")
 437
 438 (defvar nnir-current-server nil
 439   "Internal: stores current server (does it ever change?).")
 440
 441 (defvar nnir-current-group-marked nil
 442   "Internal: stores current list of process-marked groups.")
 443
 444 (defvar nnir-artlist nil
 445   "Internal: stores search result.")
 446
 447 (defvar nnir-tmp-buffer " *nnir*"
 448   "Internal: temporary buffer.")
 449
 450 (defvar nnir-search-history ()
 451   "Internal: the history for querying search options in nnir")
 452
 453 (defvar nnir-extra-parms nil
 454   "Internal: stores request for extra search parms")
 455
 456 ;;; Code:
 457
 458 ;; Gnus glue.
 459
 460 (defun gnus-group-make-nnir-group (nnir-extra-parms)
 461   "Create an nnir group.  Asks for query."
 462   (interactive "P")
 463   (setq nnir-current-query nil
 464         nnir-current-server nil
 465         nnir-current-group-marked nil
 466         nnir-artlist nil)
 467   (let* ((query (read-string "Query: " nil 'nnir-search-history))
 468          (parms (list (cons 'query query)))
 469          (srv (if (gnus-server-server-name)
 470                   "all" "")))
 471     (add-to-list 'parms (cons 'unique-id (message-unique-id)) t)
 472     (gnus-group-read-ephemeral-group
 473      (concat "nnir:" (prin1-to-string parms)) (list 'nnir srv) t
 474      (cons (current-buffer) gnus-current-window-configuration)
 475      nil)))
 476
 477
 478 ;; Gnus backend interface functions.
 479
 480 (deffoo nnir-open-server (server &optional definitions)
 481   ;; Just set the server variables appropriately.
 482   (nnoo-change-server 'nnir server definitions))
 483
 484 (deffoo nnir-request-group (group &optional server fast info)
 485   "GROUP is the query string."
 486   (nnir-possibly-change-server server)
 487   ;; Check for cache and return that if appropriate.
 488   (if (and (equal group nnir-current-query)
 489            (equal gnus-group-marked nnir-current-group-marked)
 490            (or (null server)
 491                (equal server nnir-current-server)))
 492       nnir-artlist
 493     ;; Cache miss.
 494     (setq nnir-artlist (nnir-run-query group server)))
 495   (with-current-buffer nntp-server-buffer
 496     (setq nnir-current-query group)
 497     (when server (setq nnir-current-server server))
 498     (setq nnir-current-group-marked gnus-group-marked)
 499     (if (zerop (length nnir-artlist))
 500         (nnheader-report 'nnir "Search produced empty results.")
 501       ;; Remember data for cache.
 502       (nnheader-insert "211 %d %d %d %s\n"
 503                        (nnir-artlist-length nnir-artlist) ; total #
 504                        1              ; first #
 505                        (nnir-artlist-length nnir-artlist) ; last #
 506                        group))))      ; group name
 507
 508 (deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
 509   (save-excursion
 510     (let ((artlist (copy-sequence articles))
 511           art artitem artgroup artno artrsv artfullgroup
 512           novitem novdata foo server)
 513       (while (not (null artlist))
 514         (setq art (car artlist))
 515         (or (numberp art)
 516             (nnheader-report
 517              'nnir
 518              "nnir-retrieve-headers doesn't grok message ids: %s"
 519              art))
 520         (setq artitem (nnir-artlist-article nnir-artlist art))
 521         (setq artrsv (nnir-artitem-rsv artitem))
 522         (setq artfullgroup (nnir-artitem-group artitem))
 523         (setq artno (nnir-artitem-number artitem))
 524         (setq artgroup (gnus-group-real-name artfullgroup))
 525         (setq server (gnus-group-server artfullgroup))
 526         ;; retrieve NOV or HEAD data for this article, transform into
 527         ;; NOV data and prepend to `novdata'
 528         (set-buffer nntp-server-buffer)
 529         (nnir-possibly-change-server server)
 530         (let ((gnus-override-method
 531                (gnus-server-to-method server)))
 532           ;; if nnir-get-article-nov-override-function is set, use it
 533           (if nnir-get-article-nov-override-function
 534               (setq novitem (funcall nnir-get-article-nov-override-function
 535                                      artitem))
 536             ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
 537             (case (setq foo (gnus-retrieve-headers (list artno)
 538                                                    artfullgroup nil))
 539               (nov
 540                (goto-char (point-min))
 541                (setq novitem (nnheader-parse-nov)))
 542               (headers
 543                (goto-char (point-min))
 544                (setq novitem (nnheader-parse-head)))
 545               (t (error "Unknown header type %s while requesting article %s of group %s"
 546                         foo artno artfullgroup)))))
 547         ;; replace article number in original group with article number
 548         ;; in nnir group
 549         (when novitem
 550           (mail-header-set-number novitem art)
 551           (mail-header-set-from novitem
 552                                 (mail-header-from novitem))
 553           (mail-header-set-subject
 554            novitem
 555            (format "[%d: %s/%d] %s"
 556                    artrsv artgroup artno
 557                    (mail-header-subject novitem)))
 558           (push novitem novdata)
 559           (setq artlist (cdr artlist))))
 560       (setq novdata (nreverse novdata))
 561       (set-buffer nntp-server-buffer) (erase-buffer)
 562       (mapc 'nnheader-insert-nov novdata)
 563       'nov)))
 564
 565 (deffoo nnir-request-article (article
 566                               &optional group server to-buffer)
 567   (if (stringp article)
 568       (nnheader-report
 569        'nnir
 570        "nnir-retrieve-headers doesn't grok message ids: %s"
 571        article)
 572     (save-excursion
 573       (let* ((artitem (nnir-artlist-article nnir-artlist
 574                                             article))
 575              (artfullgroup (nnir-artitem-group artitem))
 576              (artno (nnir-artitem-number artitem))
 577              ;; Bug?
 578              ;; Why must we bind nntp-server-buffer here?  It won't
 579              ;; work if `buf' is used, say.  (Of course, the set-buffer
 580              ;; line below must then be updated, too.)
 581              (nntp-server-buffer (or to-buffer nntp-server-buffer)))
 582         (set-buffer nntp-server-buffer)
 583         (erase-buffer)
 584         (message "Requesting article %d from group %s"
 585                  artno artfullgroup)
 586         (gnus-request-article artno artfullgroup nntp-server-buffer)
 587         (cons artfullgroup artno)))))
 588
 589 (deffoo nnir-request-move-article (article group server accept-form
 590                                            &optional last internal-move-group)
 591   (let* ((artitem (nnir-artlist-article nnir-artlist
 592                                         article))
 593          (artfullgroup (nnir-artitem-group artitem))
 594          (artno (nnir-artitem-number artitem))
 595          (to-newsgroup (nth 1 accept-form))
 596          (to-method (gnus-find-method-for-group to-newsgroup))
 597          (from-method (gnus-find-method-for-group artfullgroup))
 598          (move-is-internal (gnus-server-equal from-method to-method)))
 599     (gnus-request-move-article
 600      artno
 601      artfullgroup
 602      (nth 1 from-method)
 603      accept-form
 604      last
 605      (and move-is-internal
 606           to-newsgroup          ; Not respooling
 607           (gnus-group-real-name to-newsgroup))) ; Is this move internal
 608     ))
 609
 610 (deffoo nnir-warp-to-article ()
 611   (let* ((cur (gnus-summary-article-number))
 612          (gnus-newsgroup-name (nnir-artlist-artitem-group nnir-artlist cur))
 613          (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
 614     (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer
 615                                nil (list backend-number))))
 616
 617 (nnoo-define-skeleton nnir)
 618
 619
 620 (defmacro nnir-add-result (dirnam artno score prefix server artlist)
 621   "Ask `nnir-compose-result' to construct a result vector,
 622 and if it is non-nil, add it to artlist."
 623   `(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server)))
 624      (when (not (null result))
 625        (push result ,artlist))))
 626
 627 (autoload 'nnmaildir-base-name-to-article-number "nnmaildir")
 628
 629 ;; Helper function currently used by the Swish++ and Namazu backends;
 630 ;; perhaps useful for other backends as well
 631 (defun nnir-compose-result (dirnam article score prefix server)
 632   "Extract the group from dirnam, and create a result vector
 633 ready to be added to the list of search results."
 634
 635   ;; remove nnir-*-remove-prefix from beginning of dirnam filename
 636   (when (string-match (concat "^" prefix) dirnam)
 637     (setq dirnam (replace-match "" t t dirnam)))
 638
 639   (when (file-readable-p (concat prefix dirnam article))
 640     ;; remove trailing slash and, for nnmaildir, cur/new/tmp
 641     (setq dirnam
 642           (substring dirnam 0
 643                      (if (string= (gnus-group-server server) "nnmaildir")
 644                          -5 -1)))
 645
 646     ;; Set group to dirnam without any leading dots or slashes,
 647     ;; and with all subsequent slashes replaced by dots
 648     (let ((group (gnus-replace-in-string
 649                  (gnus-replace-in-string dirnam "^[./\\]" "" t)
 650                  "[/\\]" "." t)))
 651
 652     (vector (nnir-group-full-name group server)
 653             (if (string= (gnus-group-server server) "nnmaildir")
 654                 (nnmaildir-base-name-to-article-number
 655                  (substring article 0 (string-match ":" article))
 656                  group nil)
 657               (string-to-number article))
 658             (string-to-number score)))))
 659
 660 ;;; Search Engine Interfaces:
 661
 662 ;; imap interface
 663 (defun nnir-run-imap (query srv &optional groups)
 664   "Run a search against an IMAP back-end server.
 665 This uses a custom query language parser; see `nnir-imap-make-query' for
 666 details on the language and supported extensions"
 667   (save-excursion
 668     (let ((qstring (cdr (assq 'query query)))
 669           (server (cadr (gnus-server-to-method srv)))
 670           (defs (caddr (gnus-server-to-method srv)))
 671           (criteria (or (cdr (assq 'criteria query))
 672                         (cdr (assoc nnir-imap-default-search-key
 673                                     nnir-imap-search-arguments))))
 674           (gnus-inhibit-demon t)
 675           (groups (or groups (nnir-get-active srv)))
 676           artlist)
 677       (message "Opening server %s" server)
 678       (apply
 679        'vconcat
 680        (mapcar
 681         (lambda (x)
 682           (let ((group x))
 683             (condition-case ()
 684                 (when (nnimap-possibly-change-group
 685                        (gnus-group-short-name group) server)
 686                   (with-current-buffer (nnimap-buffer)
 687                     (message "Searching %s..." group)
 688                     (let ((arts 0)
 689                           (result (nnimap-command "UID SEARCH %s"
 690                                                   (if (string= criteria "")
 691                                                       qstring
 692                                                     (nnir-imap-make-query
 693                                                      criteria qstring)))))
 694                       (mapc
 695                        (lambda (artnum) (push (vector group artnum 1) artlist)
 696                          (setq arts (1+ arts)))
 697                        (and (car result)
 698                             (delete 0 (mapcar #'string-to-number
 699                                               (cdr (assoc "SEARCH"
 700                                                           (cdr result)))))))
 701                       (message "Searching %s... %d matches" group arts)))
 702                   (message "Searching %s...done" group))
 703               (quit nil))
 704             (reverse artlist)))
 705         groups)))))
 706
 707 (defun nnir-imap-make-query (criteria qstring)
 708   "Parse the query string and criteria into an appropriate IMAP search
 709 expression, returning the string query to make.
 710
 711 This implements a little language designed to return the expected results
 712 to an arbitrary query string to the end user.
 713
 714 The search is always case-insensitive, as defined by RFC2060, and supports
 715 the following features (inspired by the Google search input language):
 716
 717 Automatic \"and\" queries
 718     If you specify multiple words then they will be treated as an \"and\"
 719     expression intended to match all components.
 720
 721 Phrase searches
 722     If you wrap your query in double-quotes then it will be treated as a
 723     literal string.
 724
 725 Negative terms
 726     If you precede a term with \"-\" then it will negate that.
 727
 728 \"OR\" queries
 729     If you include an upper-case \"OR\" in your search it will cause the
 730     term before it and the term after it to be treated as alternatives.
 731
 732 In future the following will be added to the language:
 733  * support for date matches
 734  * support for location of text matching within the query
 735  * from/to/etc headers
 736  * additional search terms
 737  * flag based searching
 738  * anything else that the RFC supports, basically."
 739   ;; Walk through the query and turn it into an IMAP query string.
 740   (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring)))
 741
 742
 743 (defun nnir-imap-query-to-imap (criteria query)
 744   "Turn a s-expression format query into IMAP."
 745   (mapconcat
 746    ;; Turn the expressions into IMAP text
 747    (lambda (item)
 748      (nnir-imap-expr-to-imap criteria item))
 749    ;; The query, already in s-expr format.
 750    query
 751    ;; Append a space between each expression
 752    " "))
 753
 754
 755 (defun nnir-imap-expr-to-imap (criteria expr)
 756   "Convert EXPR into an IMAP search expression on CRITERIA"
 757   ;; What sort of expression is this, eh?
 758   (cond
 759    ;; Simple string term
 760    ((stringp expr)
 761     (format "%s %S" criteria expr))
 762    ;; Trivial term: and
 763    ((eq expr 'and) nil)
 764    ;; Composite term: or expression
 765    ((eq (car-safe expr) 'or)
 766     (format "OR %s %s"
 767             (nnir-imap-expr-to-imap criteria (second expr))
 768             (nnir-imap-expr-to-imap criteria (third expr))))
 769    ;; Composite term: just the fax, mam
 770    ((eq (car-safe expr) 'not)
 771     (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
 772    ;; Composite term: just expand it all.
 773    ((and (not (null expr)) (listp expr))
 774     (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
 775    ;; Complex value, give up for now.
 776    (t (error "Unhandled input: %S" expr))))
 777
 778
 779 (defun nnir-imap-parse-query (string)
 780   "Turn STRING into an s-expression based query based on the IMAP
 781 query language as defined in `nnir-imap-make-query'.
 782
 783 This involves turning individual tokens into higher level terms
 784 that the search language can then understand and use."
 785   (with-temp-buffer
 786     ;; Set up the parsing environment.
 787     (insert string)
 788     (goto-char (point-min))
 789     ;; Now, collect the output terms and return them.
 790     (let (out)
 791       (while (not (nnir-imap-end-of-input))
 792         (push (nnir-imap-next-expr) out))
 793       (reverse out))))
 794
 795
 796 (defun nnir-imap-next-expr (&optional count)
 797   "Return the next expression from the current buffer."
 798   (let ((term (nnir-imap-next-term count))
 799         (next (nnir-imap-peek-symbol)))
 800     ;; Are we looking at an 'or' expression?
 801     (cond
 802      ;; Handle 'expr or expr'
 803      ((eq next 'or)
 804       (list 'or term (nnir-imap-next-expr 2)))
 805      ;; Anything else
 806      (t term))))
 807
 808
 809 (defun nnir-imap-next-term (&optional count)
 810   "Return the next TERM from the current buffer."
 811   (let ((term (nnir-imap-next-symbol count)))
 812     ;; What sort of term is this?
 813     (cond
 814      ;; and -- just ignore it
 815      ((eq term 'and) 'and)
 816      ;; negated term
 817      ((eq term 'not) (list 'not (nnir-imap-next-expr)))
 818      ;; generic term
 819      (t term))))
 820
 821
 822 (defun nnir-imap-peek-symbol ()
 823   "Return the next symbol from the current buffer, but don't consume it."
 824   (save-excursion
 825     (nnir-imap-next-symbol)))
 826
 827 (defun nnir-imap-next-symbol (&optional count)
 828   "Return the next symbol from the current buffer, or nil if we are
 829 at the end of the buffer.  If supplied COUNT skips some symbols before
 830 returning the one at the supplied position."
 831   (when (and (numberp count) (> count 1))
 832     (nnir-imap-next-symbol (1- count)))
 833   (let ((case-fold-search t))
 834     ;; end of input stream?
 835     (unless (nnir-imap-end-of-input)
 836       ;; No, return the next symbol from the stream.
 837       (cond
 838        ;; negated expression -- return it and advance one char.
 839        ((looking-at "-") (forward-char 1) 'not)
 840        ;; quoted string
 841        ((looking-at "\"") (nnir-imap-delimited-string "\""))
 842        ;; list expression -- we parse the content and return this as a list.
 843        ((looking-at "(")
 844         (nnir-imap-parse-query (nnir-imap-delimited-string ")")))
 845        ;; keyword input -- return a symbol version
 846        ((looking-at "\\band\\b") (forward-char 3) 'and)
 847        ((looking-at "\\bor\\b")  (forward-char 2) 'or)
 848        ((looking-at "\\bnot\\b") (forward-char 3) 'not)
 849        ;; Simple, boring keyword
 850        (t (let ((start (point))
 851                 (end (if (search-forward-regexp "[[:blank:]]" nil t)
 852                          (prog1
 853                              (match-beginning 0)
 854                            ;; unskip if we hit a non-blank terminal character.
 855                            (when (string-match "[^[:blank:]]" (match-string 0))
 856                              (backward-char 1)))
 857                        (goto-char (point-max)))))
 858             (buffer-substring start end)))))))
 859
 860 (defun nnir-imap-delimited-string (delimiter)
 861   "Return a delimited string from the current buffer."
 862   (let ((start (point)) end)
 863     (forward-char 1)                    ; skip the first delimiter.
 864     (while (not end)
 865       (unless (search-forward delimiter nil t)
 866         (error "Unmatched delimited input with %s in query" delimiter))
 867       (let ((here (point)))
 868         (unless (equal (buffer-substring (- here 2) (- here 1)) "\\")
 869           (setq end (point)))))
 870     (buffer-substring (1+ start) (1- end))))
 871
 872 (defun nnir-imap-end-of-input ()
 873   "Are we at the end of input?"
 874   (skip-chars-forward "[[:blank:]]")
 875   (looking-at "$"))
 876
 877
 878 ;; Swish++ interface.
 879 ;; -cc- Todo
 880 ;; Search by
 881 ;; - group
 882 ;; Sort by
 883 ;; - rank (default)
 884 ;; - article number
 885 ;; - file size
 886 ;; - group
 887 (defun nnir-run-swish++ (query server &optional group)
 888   "Run QUERY against swish++.
 889 Returns a vector of (group name, file name) pairs (also vectors,
 890 actually).
 891
 892 Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on
 893 Windows NT 4.0."
 894
 895   ;; (when group
 896   ;;   (error "The swish++ backend cannot search specific groups"))
 897
 898   (save-excursion
 899     (let ( (qstring (cdr (assq 'query query)))
 900            (groupspec (cdr (assq 'group query)))
 901            (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server))
 902            artlist
 903            ;; nnml-use-compressed-files might be any string, but probably this
 904            ;; is sufficient.  Note that we can't only use the value of
 905            ;; nnml-use-compressed-files because old articles might have been
 906            ;; saved with a different value.
 907            (article-pattern (if (string= (gnus-group-server server) "nnmaildir")
 908                                 ":[0-9]+"
 909                               "^[0-9]+\\(\\.[a-z0-9]+\\)?$"))
 910            score artno dirnam filenam)
 911
 912       (when (equal "" qstring)
 913         (error "swish++: You didn't enter anything"))
 914
 915       (set-buffer (get-buffer-create nnir-tmp-buffer))
 916       (erase-buffer)
 917
 918       (if groupspec
 919           (message "Doing swish++ query %s on %s..." qstring groupspec)
 920         (message "Doing swish++ query %s..." qstring))
 921
 922       (let* ((cp-list `( ,nnir-swish++-program
 923                          nil            ; input from /dev/null
 924                          t              ; output
 925                          nil            ; don't redisplay
 926                          "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server)
 927                          ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server)
 928                          ,qstring       ; the query, in swish++ format
 929                          ))
 930              (exitstatus
 931               (progn
 932                 (message "%s args: %s" nnir-swish++-program
 933                          (mapconcat 'identity (cddddr cp-list) " ")) ;; ???
 934                 (apply 'call-process cp-list))))
 935         (unless (or (null exitstatus)
 936                     (zerop exitstatus))
 937           (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus)
 938           ;; swish++ failure reason is in this buffer, show it if
 939           ;; the user wants it.
 940           (when (> gnus-verbose 6)
 941             (display-buffer nnir-tmp-buffer))))
 942
 943       ;; The results are output in the format of:
 944       ;; V 4.7 Linux
 945       ;; rank relative-path-name file-size file-title
 946       ;; V 5.0b2:
 947       ;; rank relative-path-name file-size topic??
 948       ;; where rank is an integer from 1 to 100.
 949       (goto-char (point-min))
 950       (while (re-search-forward
 951               "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
 952         (setq score (match-string 1)
 953               filenam (match-string 2)
 954               artno (file-name-nondirectory filenam)
 955               dirnam (file-name-directory filenam))
 956
 957         ;; don't match directories
 958         (when (string-match article-pattern artno)
 959           (when (not (null dirnam))
 960
 961             ;; maybe limit results to matching groups.
 962             (when (or (not groupspec)
 963                       (string-match groupspec dirnam))
 964               (nnir-add-result dirnam artno score prefix server artlist)))))
 965
 966       (message "Massaging swish++ output...done")
 967
 968       ;; Sort by score
 969       (apply 'vector
 970              (sort artlist
 971                    (function (lambda (x y)
 972                                (> (nnir-artitem-rsv x)
 973                                   (nnir-artitem-rsv y)))))))))
 974
 975 ;; Swish-E interface.
 976 (defun nnir-run-swish-e (query server &optional group)
 977   "Run given query against swish-e.
 978 Returns a vector of (group name, file name) pairs (also vectors,
 979 actually).
 980
 981 Tested with swish-e-2.0.1 on Windows NT 4.0."
 982
 983   ;; swish-e crashes with empty parameter to "-w" on commandline...
 984   ;; (when group
 985   ;;   (error "The swish-e backend cannot search specific groups"))
 986
 987   (save-excursion
 988     (let ((qstring (cdr (assq 'query query)))
 989           (prefix
 990            (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server)
 991                (error "Missing parameter `nnir-swish-e-remove-prefix'")))
 992           artlist score artno dirnam group )
 993
 994       (when (equal "" qstring)
 995         (error "swish-e: You didn't enter anything"))
 996
 997       (set-buffer (get-buffer-create nnir-tmp-buffer))
 998       (erase-buffer)
 999
1000       (message "Doing swish-e query %s..." query)
1001       (let* ((index-files
1002               (or (nnir-read-server-parm
1003                    'nnir-swish-e-index-files server)
1004                   (error "Missing parameter `nnir-swish-e-index-files'")))
1005              (additional-switches
1006               (nnir-read-server-parm
1007                'nnir-swish-e-additional-switches server))
1008              (cp-list `(,nnir-swish-e-program
1009                         nil             ; input from /dev/null
1010                         t               ; output
1011                         nil             ; don't redisplay
1012                         "-f" ,@index-files
1013                         ,@additional-switches
1014                         "-w"
1015                         ,qstring        ; the query, in swish-e format
1016                         ))
1017              (exitstatus
1018               (progn
1019                 (message "%s args: %s" nnir-swish-e-program
1020                          (mapconcat 'identity (cddddr cp-list) " "))
1021                 (apply 'call-process cp-list))))
1022         (unless (or (null exitstatus)
1023                     (zerop exitstatus))
1024           (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus)
1025           ;; swish-e failure reason is in this buffer, show it if
1026           ;; the user wants it.
1027           (when (> gnus-verbose 6)
1028             (display-buffer nnir-tmp-buffer))))
1029
1030       ;; The results are output in the format of:
1031       ;; rank path-name file-title file-size
1032       (goto-char (point-min))
1033       (while (re-search-forward
1034               "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
1035         (setq score (match-string 1)
1036               artno (match-string 3)
1037               dirnam (file-name-directory (match-string 2)))
1038
1039         ;; don't match directories
1040         (when (string-match "^[0-9]+$" artno)
1041           (when (not (null dirnam))
1042
1043             ;; remove nnir-swish-e-remove-prefix from beginning of dirname
1044             (when (string-match (concat "^" prefix) dirnam)
1045               (setq dirnam (replace-match "" t t dirnam)))
1046
1047             (setq dirnam (substring dirnam 0 -1))
1048             ;; eliminate all ".", "/", "\" from beginning. Always matches.
1049             (string-match "^[./\\]*\\(.*\\)$" dirnam)
1050             ;; "/" -> "."
1051             (setq group (gnus-replace-in-string (match-string 1 dirnam) "/" "."))
1052             ;; Windows "\\" -> "."
1053             (setq group (gnus-replace-in-string group "\\\\" "."))
1054
1055             (push (vector (nnir-group-full-name group server)
1056                           (string-to-number artno)
1057                           (string-to-number score))
1058                   artlist))))
1059
1060       (message "Massaging swish-e output...done")
1061
1062       ;; Sort by score
1063       (apply 'vector
1064              (sort artlist
1065                    (function (lambda (x y)
1066                                (> (nnir-artitem-rsv x)
1067                                   (nnir-artitem-rsv y)))))))))
1068
1069 ;; HyREX interface
1070 (defun nnir-run-hyrex (query server &optional group)
1071   (save-excursion
1072     (let ((artlist nil)
1073           (groupspec (cdr (assq 'group query)))
1074           (qstring (cdr (assq 'query query)))
1075           (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server))
1076           score artno dirnam)
1077       (when (and (not groupspec) group)
1078         (setq groupspec
1079               (regexp-opt
1080                (mapcar (lambda (x) (gnus-group-real-name x)) group))))
1081       (set-buffer (get-buffer-create nnir-tmp-buffer))
1082       (erase-buffer)
1083       (message "Doing hyrex-search query %s..." query)
1084       (let* ((cp-list
1085               `( ,nnir-hyrex-program
1086                  nil                    ; input from /dev/null
1087                  t                      ; output
1088                  nil                    ; don't redisplay
1089                  "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory
1090                  ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server)
1091                  ,qstring          ; the query, in hyrex-search format
1092                  ))
1093              (exitstatus
1094               (progn
1095                 (message "%s args: %s" nnir-hyrex-program
1096                          (mapconcat 'identity (cddddr cp-list) " "))
1097                 (apply 'call-process cp-list))))
1098         (unless (or (null exitstatus)
1099                     (zerop exitstatus))
1100           (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus)
1101           ;; nnir-search failure reason is in this buffer, show it if
1102           ;; the user wants it.
1103           (when (> gnus-verbose 6)
1104             (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer !
1105       (message "Doing hyrex-search query \"%s\"...done" qstring)
1106       (sit-for 0)
1107       ;; nnir-search returns:
1108       ;;   for nnml/nnfolder: "filename mailid weigth"
1109       ;;   for nnimap:        "group mailid weigth"
1110       (goto-char (point-min))
1111       (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$")
1112       ;; HyREX doesn't search directly in groups -- so filter out here.
1113       (when groupspec
1114         (keep-lines groupspec))
1115       ;; extract data from result lines
1116       (goto-char (point-min))
1117       (while (re-search-forward
1118               "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t)
1119         (setq dirnam (match-string 1)
1120               artno (match-string 2)
1121               score (match-string 3))
1122         (when (string-match prefix dirnam)
1123           (setq dirnam (replace-match "" t t dirnam)))
1124         (push (vector (nnir-group-full-name
1125                        (gnus-replace-in-string dirnam "/" ".") server)
1126                       (string-to-number artno)
1127                       (string-to-number score))
1128               artlist))
1129       (message "Massaging hyrex-search output...done.")
1130       (apply 'vector
1131              (sort artlist
1132                    (function (lambda (x y)
1133                                (if (string-lessp (nnir-artitem-group x)
1134                                                  (nnir-artitem-group y))
1135                                    t
1136                                  (< (nnir-artitem-number x)
1137                                     (nnir-artitem-number y)))))))
1138       )))
1139
1140 ;; Namazu interface
1141 (defun nnir-run-namazu (query server &optional group)
1142   "Run given query against Namazu.  Returns a vector of (group name, file name)
1143 pairs (also vectors, actually).
1144
1145 Tested with Namazu 2.0.6 on a GNU/Linux system."
1146   ;; (when group
1147   ;;   (error "The Namazu backend cannot search specific groups"))
1148   (save-excursion
1149     (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir")
1150                                ":[0-9]+"
1151                              "^[0-9]+$"))
1152           artlist
1153           (qstring (cdr (assq 'query query)))
1154           (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server))
1155           score group article
1156           (process-environment (copy-sequence process-environment)))
1157       (setenv "LC_MESSAGES" "C")
1158       (set-buffer (get-buffer-create nnir-tmp-buffer))
1159       (erase-buffer)
1160       (let* ((cp-list
1161               `( ,nnir-namazu-program
1162                  nil                    ; input from /dev/null
1163                  t                      ; output
1164                  nil                    ; don't redisplay
1165                  "-q"                   ; don't be verbose
1166                  "-a"                   ; show all matches
1167                  "-s"                   ; use short format
1168                  ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server)
1169                  ,qstring               ; the query, in namazu format
1170                  ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory
1171                  ))
1172              (exitstatus
1173               (progn
1174                 (message "%s args: %s" nnir-namazu-program
1175                          (mapconcat 'identity (cddddr cp-list) " "))
1176                 (apply 'call-process cp-list))))
1177         (unless (or (null exitstatus)
1178                     (zerop exitstatus))
1179           (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus)
1180           ;; Namazu failure reason is in this buffer, show it if
1181           ;; the user wants it.
1182           (when (> gnus-verbose 6)
1183             (display-buffer nnir-tmp-buffer))))
1184
1185       ;; Namazu output looks something like this:
1186       ;; 2. Re: Gnus agent expire broken (score: 55)
1187       ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes)
1188
1189       (goto-char (point-min))
1190       (while (re-search-forward
1191               "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
1192               nil t)
1193         (setq score (match-string 3)
1194               group (file-name-directory (match-string 4))
1195               article (file-name-nondirectory (match-string 4)))
1196
1197         ;; make sure article and group is sane
1198         (when (and (string-match article-pattern article)
1199                    (not (null group)))
1200           (nnir-add-result group article score prefix server artlist)))
1201
1202       ;; sort artlist by score
1203       (apply 'vector
1204              (sort artlist
1205                    (function (lambda (x y)
1206                                (> (nnir-artitem-rsv x)
1207                                   (nnir-artitem-rsv y)))))))))
1208
1209 (defun nnir-run-find-grep (query server &optional grouplist)
1210   "Run find and grep to obtain matching articles."
1211   (let* ((method (gnus-server-to-method server))
1212          (sym (intern
1213                (concat (symbol-name (car method)) "-directory")))
1214          (directory (cadr (assoc sym (cddr method))))
1215          (regexp (cdr (assoc 'query query)))
1216          (grep-options (cdr (assoc 'grep-options query)))
1217          artlist)
1218     (unless directory
1219       (error "No directory found in method specification of server %s"
1220              server))
1221     (apply
1222      'vconcat
1223      (mapcar (lambda (x)
1224                (let ((group x))
1225                  (message "Searching %s using find-grep..."
1226                           (or group server))
1227                  (save-window-excursion
1228                    (set-buffer (get-buffer-create nnir-tmp-buffer))
1229                    (erase-buffer)
1230                    (if (> gnus-verbose 6)
1231                        (pop-to-buffer (current-buffer)))
1232                    (cd directory) ; Using relative paths simplifies
1233                                   ; postprocessing.
1234                    (let ((group
1235                           (if (not group)
1236                               "."
1237                             ;; Try accessing the group literally as
1238                             ;; well as interpreting dots as directory
1239                             ;; separators so the engine works with
1240                             ;; plain nnml as well as the Gnus Cache.
1241                             (let ((group (gnus-group-real-name group)))
1242                               ;; Replace cl-func find-if.
1243                               (if (file-directory-p group)
1244                                   group
1245                                 (if (file-directory-p
1246                                      (setq group
1247                                            (gnus-replace-in-string
1248                                             group
1249                                             "\\." "/" t)))
1250                                     group))))))
1251                      (unless group
1252                        (error "Cannot locate directory for group"))
1253                      (save-excursion
1254                        (apply
1255                         'call-process "find" nil t
1256                         "find" group "-type" "f" "-name" "[0-9]*" "-exec"
1257                         "grep"
1258                         `("-l" ,@(and grep-options
1259                                       (split-string grep-options "\\s-" t))
1260                           "-e" ,regexp "{}" "+"))))
1261
1262                    ;; Translate relative paths to group names.
1263                    (while (not (eobp))
1264                      (let* ((path (split-string
1265                                    (buffer-substring
1266                                     (point)
1267                                     (line-end-position)) "/" t))
1268                             (art (string-to-number (car (last path)))))
1269                        (while (string= "." (car path))
1270                          (setq path (cdr path)))
1271                        (let ((group (mapconcat 'identity
1272                                                ;; Replace cl-func:
1273                                                ;; (subseq path 0 -1)
1274                                                (let ((end (1- (length path)))
1275                                                      res)
1276                                                  (while
1277                                                      (>= (setq end (1- end)) 0)
1278                                                    (push (pop path) res))
1279                                                  (nreverse res))
1280                                                ".")))
1281                          (push
1282                           (vector (nnir-group-full-name group server) art 0)
1283                           artlist))
1284                        (forward-line 1)))
1285                    (message "Searching %s using find-grep...done"
1286                             (or group server))
1287                    artlist)))
1288      grouplist))))
1289
1290 (declare-function mm-url-insert "mm-url" (url &optional follow-refresh))
1291 (declare-function mm-url-encode-www-form-urlencoded "mm-url" (pairs))
1292
1293 ;; gmane interface
1294 (defun nnir-run-gmane (query srv &optional groups)
1295   "Run a search against a gmane back-end server."
1296   (if (gnus-string-match-p "gmane" srv)
1297       (let* ((case-fold-search t)
1298              (qstring (cdr (assq 'query query)))
1299              (server (cadr (gnus-server-to-method srv)))
1300              (groupspec (if groups
1301                             (mapconcat
1302                              (function (lambda (x)
1303                                          (format "group:%s"
1304                                                  (gnus-group-short-name x))))
1305                              groups " ") ""))
1306              (authorspec
1307               (if (assq 'author query)
1308                   (format "author:%s" (cdr (assq 'author query))) ""))
1309              (search (format "%s %s %s"
1310                              qstring groupspec authorspec))
1311              (gnus-inhibit-demon t)
1312              artlist)
1313         (require 'mm-url)
1314         (with-current-buffer nntp-server-buffer
1315           (erase-buffer)
1316           (mm-url-insert
1317            (concat
1318             "http://search.gmane.org/nov.php"
1319             "?"
1320             (mm-url-encode-www-form-urlencoded
1321              `(("query" . ,search)
1322                ("HITSPERPAGE" . "999")))))
1323           (unless (featurep 'xemacs) (set-buffer-multibyte t))
1324           (mm-decode-coding-region (point-min) (point-max) 'utf-8)
1325           (goto-char (point-min))
1326           (forward-line 1)
1327           (while (not (eobp))
1328             (unless (or (eolp) (looking-at "\x0d"))
1329               (let ((header (nnheader-parse-nov)))
1330                 (let ((xref (mail-header-xref header))
1331                       (xscore (string-to-number (cdr (assoc 'X-Score
1332                                (mail-header-extra header))))))
1333                   (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
1334                     (push
1335                      (vector
1336                       (gnus-group-prefixed-name (match-string 1 xref) srv)
1337                       (string-to-number (match-string 2 xref)) xscore)
1338                      artlist)))))
1339             (forward-line 1)))
1340         ;; Sort by score
1341         (apply 'vector
1342                (sort artlist
1343                      (function (lambda (x y)
1344                                  (> (nnir-artitem-rsv x)
1345                                     (nnir-artitem-rsv y)))))))
1346     (message "Can't search non-gmane nntp groups")
1347     nil))
1348
1349 ;;; Util Code:
1350
1351 (defun nnir-read-parms (query nnir-search-engine)
1352   "Reads additional search parameters according to `nnir-engines'."
1353   (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
1354     (append query
1355            (mapcar 'nnir-read-parm parmspec))))
1356
1357 (defun nnir-read-parm (parmspec)
1358   "Reads a single search parameter.
1359 `parmspec' is a cons cell, the car is a symbol, the cdr is a prompt."
1360   (let ((sym (car parmspec))
1361         (prompt (cdr parmspec)))
1362     (if (listp prompt)
1363         (let* ((result (apply 'gnus-completing-read prompt))
1364                (mapping (or (assoc result nnir-imap-search-arguments)
1365                             (cons nil nnir-imap-search-other))))
1366           (cons sym (format (cdr mapping) result)))
1367       (cons sym (read-string prompt)))))
1368
1369 (defun nnir-run-query (query nserver)
1370   "Invoke appropriate search engine function (see `nnir-engines').
1371   If some groups were process-marked, run the query for each of the groups
1372   and concat the results."
1373   (let ((q (car (read-from-string query)))
1374         (groups (if (string= "all-ephemeral" nserver)
1375                     (with-current-buffer gnus-server-buffer
1376                       (list (list (gnus-server-server-name))))
1377                   (nnir-sort-groups-by-server
1378                    (or gnus-group-marked
1379                        (if (gnus-group-group-name)
1380                            (list (gnus-group-group-name))
1381                          (cdr (assoc (gnus-group-topic-name)
1382                                      gnus-topic-alist))))))))
1383     (apply 'vconcat
1384            (mapcar (lambda (x)
1385                      (let* ((server (car x))
1386                             (nnir-search-engine
1387                              (or (nnir-read-server-parm 'nnir-search-engine
1388                                                         server)
1389                                  (cdr (assoc (car
1390                                               (gnus-server-to-method server))
1391                                              nnir-method-default-engines))))
1392                             search-func)
1393                        (setq search-func (cadr
1394                                           (assoc nnir-search-engine
1395                                                  nnir-engines)))
1396                        (if search-func
1397                            (funcall search-func
1398                                     (if nnir-extra-parms
1399                                         (nnir-read-parms q nnir-search-engine)
1400                                       q)
1401                                     server (cdr x))
1402                          nil)))
1403                    groups))))
1404
1405 (defun nnir-read-server-parm (key server)
1406   "Returns the parameter value of key for the given server, where
1407 server is of form 'backend:name'."
1408   (let ((method (gnus-server-to-method server)))
1409     (cond ((and method (assq key (cddr method)))
1410            (nth 1 (assq key (cddr method))))
1411           (t nil))))
1412
1413 (defun nnir-group-full-name (shortname server)
1414   "For the given group name, return a full Gnus group name.
1415 The Gnus backend/server information is added."
1416   (gnus-group-prefixed-name shortname (gnus-server-to-method server)))
1417
1418 (defun nnir-possibly-change-server (server)
1419   (unless (and server (nnir-server-opened server))
1420     (nnir-open-server server)))
1421
1422
1423 ;; Data type article list.
1424
1425 (defun nnir-artlist-length (artlist)
1426   "Returns number of articles in artlist."
1427   (length artlist))
1428
1429 (defun nnir-artlist-article (artlist n)
1430   "Returns from ARTLIST the Nth artitem (counting starting at 1)."
1431   (elt artlist (1- n)))
1432
1433 (defun nnir-artitem-group (artitem)
1434   "Returns the group from the ARTITEM."
1435   (elt artitem 0))
1436
1437 (defun nnir-artlist-artitem-group (artlist n)
1438   "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
1439   (nnir-artitem-group (nnir-artlist-article artlist n)))
1440
1441 (defun nnir-artitem-number (artitem)
1442   "Returns the number from the ARTITEM."
1443   (elt artitem 1))
1444
1445 (defun nnir-artlist-artitem-number (artlist n)
1446   "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
1447   (nnir-artitem-number (nnir-artlist-article artlist n)))
1448
1449 (defun nnir-artitem-rsv (artitem)
1450   "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
1451   (elt artitem 2))
1452
1453 (defun nnir-artlist-artitem-rsv (artlist n)
1454   "Returns from ARTLIST the Retrieval Status Value of the Nth
1455 artitem (counting from 1)."
1456   (nnir-artitem-rsv (nnir-artlist-article artlist n)))
1457
1458 ;; unused?
1459 (defun nnir-artlist-groups (artlist)
1460   "Returns a list of all groups in the given ARTLIST."
1461   (let ((res nil)
1462         (with-dups nil))
1463     ;; from each artitem, extract group component
1464     (setq with-dups (mapcar 'nnir-artitem-group artlist))
1465     ;; remove duplicates from above
1466     (mapc (function (lambda (x) (add-to-list 'res x)))
1467             with-dups)
1468     res))
1469
1470 (defun nnir-sort-groups-by-server (groups)
1471   "sorts a list of groups into an alist keyed by server"
1472 (if (car groups)
1473   (let (value)
1474     (dolist (var groups value)
1475       (let ((server (gnus-group-server var)))
1476         (if (assoc server value)
1477             (nconc (cdr (assoc server value)) (list var))
1478           (push (cons (gnus-group-server var) (list var)) value))))
1479     value)
1480   nil))
1481
1482 (defun nnir-get-active (srv)
1483   (let ((method (gnus-server-to-method srv))
1484         groups)
1485     (gnus-request-list method)
1486     (with-current-buffer nntp-server-buffer
1487       (let ((cur (current-buffer))
1488             name)
1489         (goto-char (point-min))
1490         (unless (string= gnus-ignored-newsgroups "")
1491           (delete-matching-lines gnus-ignored-newsgroups))
1492         (while (not (eobp))
1493           (ignore-errors
1494             (push (mm-string-as-unibyte
1495                    (let ((p (point)))
1496                      (skip-chars-forward "^ \t\\\\")
1497                      (setq name (buffer-substring (+ p 1) (- (point) 1)))
1498                      (gnus-group-full-name name method)))
1499                   groups))
1500           (forward-line))))
1501     groups))
1502
1503 ;; The end.
1504 (provide 'nnir)
1505
1506 ;;; nnir.el ends here