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