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