git.chise.org Git - elisp/gnus.git-/blob - lisp/nnir.el

   1 ;;; nnir.el --- search mail with various search engines
   2 ;; Copyright (C) 1998 Kai Großjohann
   3
   4 ;; $Id: nnir.el,v 1.72 2001/08/17 11:15:13 grossjoh Exp $
   5
   6 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
   7 ;; Keywords: news, mail, searching, ir, glimpse, wais
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; This is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; The most recent version of this can always be fetched from the
  29 ;; following FTP site:
  30 ;; ls6-ftp.cs.uni-dortmund.de:/pub/src/emacs
  31
  32 ;; This code is still in the development stage but I'd like other
  33 ;; people to have a look at it.  Please do not hesitate to contact me
  34 ;; with your ideas.
  35
  36 ;; What does it do?  Well, it allows you to index your mail using some
  37 ;; search engine (freeWAIS-sf and Glimpse are currently supported),
  38 ;; then type `G G' in the Group buffer and issue a query to the search
  39 ;; engine.  You will then get a buffer which shows all articles
  40 ;; matching the query, sorted by Retrieval Status Value (score).
  41
  42 ;; When looking at the retrieval result (in the Summary buffer) you
  43 ;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an
  44 ;; article.  You will be teleported into the group this article came
  45 ;; from, showing the thread this article is part of.  (See below for
  46 ;; restrictions.)
  47
  48 ;; The Lisp installation is simple: just put this file on your
  49 ;; load-path, byte-compile it, and load it from ~/.gnus or something.
  50 ;; This will install a new command `G G' in your Group buffer for
  51 ;; searching your mail.  Note that you also need to configure a number
  52 ;; of variables, as described below.
  53
  54 ;; Restrictions:
  55 ;;
  56 ;; * Currently, this expects that you use nnml or another
  57 ;;   one-file-per-message backend.
  58 ;; * It can only search one mail backend.
  59 ;; * There are restrictions to the Glimpse setup.
  60 ;; * There are restrictions to the Wais setup.
  61 ;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before
  62 ;;   limiting to the right articles.  This is much too slow, of
  63 ;;   course.  May issue a query for number of articles to fetch; you
  64 ;;   must accept the default of all articles at this point or things
  65 ;;   may break.
  66
  67 ;; The Lisp setup involves setting a few variables and setting up the
  68 ;; search engine.  The first variable to set is `nnir-mail-backend'.
  69 ;; For me, `gnus-secondary-select-methods' contains just one select
  70 ;; method, and this is also what I put in `nnir-mail-backend'.  Type
  71 ;; `C-h v nnir-mail-backend RET' for more information -- the variable
  72 ;; documentation includes more details and a few examples.  The second
  73 ;; variable to set is `nnir-search-engine'.  Choose one of the engines
  74 ;; listed in `nnir-engines'.  (Actually `nnir-engines' is an alist,
  75 ;; type `C-h v nnir-engines RET' for more information; this includes
  76 ;; examples for setting `nnir-search-engine', too.)
  77
  78 ;; You must also set up a search engine.  I'll tell you about the two
  79 ;; search engines currently supported:
  80
  81 ;; 1. freeWAIS-sf
  82 ;;
  83 ;; As always with freeWAIS-sf, you need a so-called `format file'.  I
  84 ;; use the following file:
  85 ;;
  86 ;; ,-----
  87 ;; | # Kai's format file for freeWAIS-sf for indexing mails.
  88 ;; | # Each mail is in a file, much like the MH format.
  89 ;; |
  90 ;; | # Document separator should never match -- each file is a document.
  91 ;; | record-sep: /^@this regex should never match@$/
  92 ;; |
  93 ;; | # Searchable fields specification.
  94 ;; |
  95 ;; | region: /^[sS]ubject:/ /^[sS]ubject: */
  96 ;; |         subject "Subject header" stemming TEXT BOTH
  97 ;; | end: /^[^ \t]/
  98 ;; |
  99 ;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */
 100 ;; |         to "To and Cc headers" SOUNDEX BOTH
 101 ;; | end: /^[^ \t]/
 102 ;; |
 103 ;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */
 104 ;; |         from "From header" SOUNDEX BOTH
 105 ;; | end: /^[^ \t]/
 106 ;; |
 107 ;; | region: /^$/
 108 ;; |         stemming TEXT GLOBAL
 109 ;; | end: /^@this regex should never match@$/
 110 ;; `-----
 111 ;;
 112 ;; 1998-07-22: waisindex would dump core on me for large articles with
 113 ;; the above settings.  I used /^$/ as the end regex for the global
 114 ;; field.  That seemed to work okay.
 115
 116 ;; There is a Perl module called `WAIS.pm' which is available from
 117 ;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl.  This
 118 ;; module comes with a nifty tool called `makedb', which I use for
 119 ;; indexing.  Here's my `makedb.conf':
 120 ;;
 121 ;; ,-----
 122 ;; | # Config file for makedb
 123 ;; |
 124 ;; | # Global options
 125 ;; | waisindex = /usr/local/bin/waisindex
 126 ;; | wais_opt  = -stem -t fields
 127 ;; | # `-stem' option necessary when `stemming' is specified for the
 128 ;; | # global field in the *.fmt file
 129 ;; |
 130 ;; | # Own variables
 131 ;; | homedir = /home/kai
 132 ;; |
 133 ;; | # The mail database.
 134 ;; | database        = mail
 135 ;; | files           = `find $homedir/Mail -name \*[0-9] -print`
 136 ;; | dbdir           = $homedir/.wais
 137 ;; | limit           = 100
 138 ;; `-----
 139 ;;
 140 ;; The Lisp setup involves the `nnir-wais-*' variables.  The most
 141 ;; difficult to understand variable is probably
 142 ;; `nnir-wais-remove-prefix'.  Here's what it does: the output of
 143 ;; `waissearch' basically contains the file name and the (full)
 144 ;; directory name.  As Gnus works with group names rather than
 145 ;; directory names, the directory name is transformed into a group
 146 ;; name as follows: first, a prefix is removed from the (full)
 147 ;; directory name, then all `/' are replaced with `.'.  The variable
 148 ;; `nnir-wais-remove-prefix' should contain a regex matching exactly
 149 ;; this prefix.  It defaults to `$HOME/Mail/' (note the trailing
 150 ;; slash).
 151
 152 ;; 2. Glimpse
 153 ;;
 154 ;; The code expects you to have one Glimpse index which contains all
 155 ;; your mail files.  The Lisp setup involves setting the
 156 ;; `nnir-glimpse-*' variables.  The most difficult to understand
 157 ;; variable is probably `nnir-glimpse-remove-prefix', it corresponds
 158 ;; to `nnir-wais-remove-prefix', see above.  The `nnir-glimpse-home'
 159 ;; variable should be set to the value of the `-H' option which allows
 160 ;; one to search this Glimpse index.  I have indexed my whole home
 161 ;; directory with Glimpse, so I assume a default of `$HOME'.
 162
 163 ;; 3. Namazu
 164 ;;
 165 ;; The Namazu backend requires you to have one directory containing all
 166 ;; index files, this is controlled by the `nnir-namazu-index-directory'
 167 ;; variable.  To function the `nnir-namazu-remove-prefix' variable must
 168 ;; also be correct, see the documentation for `nnir-wais-remove-prefix'
 169 ;; above.
 170 ;;
 171 ;; It is particularly important not to pass any any switches to namazu
 172 ;; that will change the output format.  Good switches to use include
 173 ;; `--sort', `--ascending', `--early' and `--late'.  Refer to the Namazu
 174 ;; documentation for further information on valid switches.
 175 ;;
 176 ;; To index my mail with the `mknmz' program I use the following
 177 ;; configuration file:
 178 ;;
 179 ;; ,----
 180 ;; | package conf;  # Don't remove this line!
 181 ;; |
 182 ;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
 183 ;; | $EXCLUDE_PATH = "spam|sent";
 184 ;; |
 185 ;; | # Header fields which should be searchable. case-insensitive
 186 ;; | $REMAIN_HEADER = "from|date|message-id|subject";
 187 ;; |
 188 ;; | # Searchable fields. case-insensitive
 189 ;; | $SEARCH_FIELD = "from|date|message-id|subject";
 190 ;; |
 191 ;; | # The max length of a word.
 192 ;; | $WORD_LENG_MAX = 128;
 193 ;; |
 194 ;; | # The max length of a field.
 195 ;; | $MAX_FIELD_LENGTH = 256;
 196 ;; `----
 197 ;;
 198 ;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and
 199 ;; ~/Mail/archive/, so to index them I go to the directory set in
 200 ;; `nnir-namazu-index-directory' and issue the following command.
 201 ;;
 202 ;;      mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
 203 ;;
 204 ;; For maximum searching efficiency I have a cron job set to run this
 205 ;; command every four hours.
 206
 207 ;; Developer information:
 208
 209 ;; I have tried to make the code expandable.  Basically, it is divided
 210 ;; into two layers.  The upper layer is somewhat like the `nnvirtual'
 211 ;; or `nnkiboze' backends: given a specification of what articles to
 212 ;; show from another backend, it creates a group containing exactly
 213 ;; those articles.  The lower layer issues a query to a search engine
 214 ;; and produces such a specification of what articles to show from the
 215 ;; other backend.
 216
 217 ;; The interface between the two layers consists of the single
 218 ;; function `nnir-run-query', which just selects the appropriate
 219 ;; function for the search engine one is using.  The input to
 220 ;; `nnir-run-query' is a string, representing the query as input by
 221 ;; the user.  The output of `nnir-run-query' is supposed to be a
 222 ;; vector, each element of which should in turn be a three-element
 223 ;; vector.  The first element should be group name of the article, the
 224 ;; second element should be the article number, and the third element
 225 ;; should be the Retrieval Status Value (RSV) as returned from the
 226 ;; search engine.  An RSV is the score assigned to the document by the
 227 ;; search engine.  For Boolean search engines like Glimpse, the RSV is
 228 ;; always 1000 (or 1 or 100, or whatever you like).
 229
 230 ;; The sorting order of the articles in the summary buffer created by
 231 ;; nnir is based on the order of the articles in the above mentioned
 232 ;; vector, so that's where you can do the sorting you'd like.  Maybe
 233 ;; it would be nice to have a way of displaying the search result
 234 ;; sorted differently?
 235
 236 ;; So what do you need to do when you want to add another search
 237 ;; engine?  You write a function that executes the query.  Temporary
 238 ;; data from the search engine can be put in `nnir-tmp-buffer'.  This
 239 ;; function should return the list of articles as a vector, as
 240 ;; described above.  Then, you need to register this backend in
 241 ;; `nnir-engines'.  Then, users can choose the backend by setting
 242 ;; `nnir-search-engine'.
 243
 244 ;; Todo, or future ideas:
 245
 246 ;; * Make it so that Glimpse can also be called without `-F'.
 247 ;;
 248 ;; * It should be possible to restrict search to certain groups.
 249 ;;
 250 ;; * There is currently no error checking.
 251 ;;
 252 ;; * The summary buffer display is currently really ugly, with all the
 253 ;;   added information in the subjects.  How could I make this
 254 ;;   prettier?
 255 ;;
 256 ;; * A function which can be called from an nnir summary buffer which
 257 ;;   teleports you into the group the current article came from and
 258 ;;   shows you the whole thread this article is part of.
 259 ;;   Implementation suggestions?
 260 ;;   (1998-07-24: There is now a preliminary implementation, but
 261 ;;   it is much too slow and quite fragile.)
 262 ;;
 263 ;; * Support other mail backends.  In particular, probably quite a few
 264 ;;   people use nnfolder.  How would one go about searching nnfolders
 265 ;;   and producing the right data needed?  The group name and the RSV
 266 ;;   are simple, but what about the article number?
 267 ;;
 268 ;; * Support compressed mail files.  Probably, just stripping off the
 269 ;;   `.gz' or `.Z' file name extension is sufficient.
 270 ;;
 271 ;; * Support a find/grep combination.
 272 ;;
 273 ;; * At least for imap, the query is performed twice.
 274 ;;
 275 ;; * Support multiple mail backends.  The information that is needed
 276 ;;   by nnir could be put in the server parameters.  (Use sensible
 277 ;;   default values, though: include the name of the backend in the
 278 ;;   default value such that people do not have to mess with the
 279 ;;   server parameters if they don't want to.)  It is not clear how to
 280 ;;   do the user interface, though.  Hm.  Maybe offer the user a
 281 ;;   completable list of backends to search?  Or use the
 282 ;;   process-marked groups to find out which backends to search?  Or
 283 ;;   always search all backends?
 284 ;;
 285
 286 ;; Have you got other ideas?
 287
 288 ;;; Setup Code:
 289
 290 (defconst nnir-version "$Id: nnir.el,v 1.72 2001/08/17 11:15:13 grossjoh Exp $"
 291   "Version of NNIR.")
 292
 293 (require 'cl)
 294 (require 'nnoo)
 295 (require 'gnus-group)
 296 (require 'gnus-sum)
 297 (eval-and-compile
 298   (require 'gnus-util))
 299
 300 (nnoo-declare nnir)
 301 (nnoo-define-basics nnir)
 302
 303 (gnus-declare-backend "nnir" 'mail)
 304
 305 ;;; Developer Extension Variable:
 306
 307 (defvar nnir-engines
 308   '((glimpse nnir-run-glimpse
 309              ((group . "Group spec: ")))
 310     (wais    nnir-run-waissearch
 311              ())
 312     (excite  nnir-run-excite-search
 313              ())
 314     (imap    nnir-run-imap
 315              ())
 316     (swish++ nnir-run-swish++
 317              ((group . "Group spec: ")))
 318     (swish-e nnir-run-swish-e
 319              ((group . "Group spec: ")))
 320     (namazu nnir-run-namazu
 321             ()))
 322 "Alist of supported search engines.
 323 Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
 324 ENGINE is a symbol designating the searching engine.  FUNCTION is also
 325 a symbol, giving the function that does the search.  The third element
 326 ARGS is a list of cons pairs (PARAM . PROMPT).  When issuing a query,
 327 the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
 328
 329 The value of `nnir-search-engine' must be one of the ENGINE symbols.
 330 For example, use the following line for searching using freeWAIS-sf:
 331     (setq nnir-search-engine 'wais)
 332 Use the following line if you read your mail via IMAP and your IMAP
 333 server supports searching:
 334     (setq nnir-search-engine 'imap)
 335 Note that you have to set additional variables for most backends.  For
 336 example, the `wais' backend needs the variables `nnir-wais-program',
 337 `nnir-wais-database' and `nnir-wais-remove-prefix'.
 338
 339 Add an entry here when adding a new search engine.")
 340
 341 ;;; User Customizable Variables:
 342
 343 (defgroup nnir nil
 344   "Search nnmh and nnml groups in Gnus with Glimpse, freeWAIS-sf, or EWS.")
 345
 346 ;; Mail backend.
 347
 348 ;; TODO:
 349 ;; If `nil', use server parameters to find out which server to search. CCC
 350 ;;
 351 (defcustom nnir-mail-backend '(nnml "")
 352   "*Specifies which backend should be searched.
 353 More precisely, this is used to determine from which backend to fetch the
 354 messages found.
 355
 356 This must be equal to an existing server, so maybe it is best to use
 357 something like the following:
 358     (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods))
 359 The above line works fine if the mail backend you want to search is
 360 the first element of gnus-secondary-select-methods (`nth' starts counting
 361 at zero)."
 362   :type '(sexp)
 363   :group 'nnir)
 364
 365 ;; Search engine to use.
 366
 367 (defcustom nnir-search-engine 'wais
 368   "*The search engine to use.  Must be a symbol.
 369 See `nnir-engines' for a list of supported engines, and for example
 370 settings of `nnir-search-engine'."
 371   :type '(sexp)
 372   :group 'nnir)
 373
 374 ;; Glimpse engine.
 375
 376 (defcustom nnir-glimpse-program "glimpse"
 377   "*Name of Glimpse executable."
 378   :type '(string)
 379   :group 'nnir)
 380
 381 (defcustom nnir-glimpse-home (getenv "HOME")
 382   "*Value of `-H' glimpse option.
 383 `~' and environment variables must be expanded, see the functions
 384 `expand-file-name' and `substitute-in-file-name'."
 385   :type '(directory)
 386   :group 'nnir)
 387
 388 (defcustom nnir-glimpse-remove-prefix (concat (getenv "HOME") "/Mail/")
 389   "*The prefix to remove from each file name returned by Glimpse
 390 in order to get a group name (albeit with / instead of .).  This is a
 391 regular expression.
 392
 393 For example, suppose that Glimpse returns file names such as
 394 \"/home/john/Mail/mail/misc/42\".  For this example, use the following
 395 setting:  (setq nnir-glimpse-remove-prefix \"/home/john/Mail/\")
 396 Note the trailing slash.  Removing this prefix gives \"mail/misc/42\".
 397 `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
 398 arrive at the correct group name, \"mail.misc\"."
 399   :type '(regexp)
 400   :group 'nnir)
 401
 402 (defcustom nnir-glimpse-additional-switches '("-i")
 403   "*A list of strings, to be given as additional arguments to glimpse.
 404 The switches `-H', `-W', `-l' and `-y' are always used -- calling
 405 glimpse without them does not make sense in our situation.
 406 Suggested elements to put here are `-i' and `-w'.
 407
 408 Note that this should be a list.  Ie, do NOT use the following:
 409     (setq nnir-glimpse-additional-switches \"-i -w\") ; wrong!
 410 Instead, use this:
 411     (setq nnir-glimpse-additional-switches '(\"-i\" \"-w\"))"
 412   :type '(repeat (string))
 413   :group 'nnir)
 414
 415 ;; freeWAIS-sf.
 416
 417 (defcustom nnir-wais-program "waissearch"
 418   "*Name of waissearch executable."
 419   :type '(string)
 420   :group 'nnir)
 421
 422 (defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
 423   "*Name of Wais database containing the mail.
 424
 425 Note that this should be a file name without extension.  For example,
 426 if you have a file /home/john/.wais/mail.fmt, use this:
 427     (setq nnir-wais-database \"/home/john/.wais/mail\")
 428 The string given here is passed to `waissearch -d' as-is."
 429   :type '(file)
 430   :group 'nnir)
 431
 432 (defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/")
 433   "*The prefix to remove from each directory name returned by waissearch
 434 in order to get a group name (albeit with / instead of .).  This is a
 435 regular expression.
 436
 437 This variable is similar to `nnir-glimpse-remove-prefix', only for Wais,
 438 not Glimpse."
 439   :type '(regexp)
 440   :group 'nnir)
 441
 442 ;; EWS (Excite for Web Servers) engine.
 443
 444 (defcustom nnir-excite-aquery-program "aquery.pl"
 445   "*Name of the EWS query program.  Should be `aquery.pl' or a path to same."
 446   :type '(string)
 447   :group 'nnir)
 448
 449 (defcustom nnir-excite-collection "Mail"
 450   "*Name of the EWS collection to search."
 451   :type '(string)
 452   :group 'nnir)
 453
 454 (defcustom nnir-excite-remove-prefix (concat (getenv "HOME") "/Mail/")
 455   "*The prefix to remove from each file name returned by EWS
 456 in order to get a group name (albeit with / instead of .).  This is a
 457 regular expression.
 458
 459 This variable is very similar to `nnir-glimpse-remove-prefix', except
 460 that it is for EWS, not Glimpse."
 461   :type '(regexp)
 462   :group 'nnir)
 463
 464 ;; Swish++.  Next three variables Copyright (C) 2000, 2001 Christoph
 465 ;; Conrad <christoph.conrad@gmx.de>.
 466 ;; Swish++ home page: http://homepage.mac.com/pauljlucas/software/swish/
 467
 468 (defcustom nnir-swish++-configuration-file
 469   (expand-file-name "~/Mail/swish++.conf")
 470   "*Configuration file for swish++."
 471   :type '(file)
 472   :group 'nnir)
 473
 474 (defcustom nnir-swish++-program "search"
 475   "*Name of swish++ search executable."
 476   :type '(string)
 477   :group 'nnir)
 478
 479 (defcustom nnir-swish++-additional-switches '()
 480     "*A list of strings, to be given as additional arguments to swish++.
 481
 482 Note that this should be a list.  Ie, do NOT use the following:
 483     (setq nnir-swish++-additional-switches \"-i -w\") ; wrong
 484 Instead, use this:
 485     (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
 486   :type '(repeat (string))
 487   :group 'nnir)
 488
 489 (defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
 490   "*The prefix to remove from each file name returned by swish++
 491 in order to get a group name (albeit with / instead of .).  This is a
 492 regular expression.
 493
 494 This variable is very similar to `nnir-glimpse-remove-prefix', except
 495 that it is for swish++, not Glimpse."
 496   :type '(regexp)
 497   :group 'nnir)
 498
 499 ;; Swish-E.  Next three variables Copyright (C) 2000 Christoph Conrad
 500 ;; <christoph.conrad@gmx.de>.
 501 ;; URL: http://sunsite.berkeley.edu/SWISH-E/
 502 ;; New version: http://www.boe.es/swish-e
 503
 504 (defcustom nnir-swish-e-index-file
 505   (expand-file-name "~/Mail/index.swish-e")
 506   "*Index file for swish-e."
 507   :type '(file)
 508   :group 'nnir)
 509
 510 (defcustom nnir-swish-e-program "swish-e"
 511   "*Name of swish-e search executable."
 512   :type '(string)
 513   :group 'nnir)
 514
 515 (defcustom nnir-swish-e-additional-switches '()
 516   "*A list of strings, to be given as additional arguments to swish-e.
 517
 518 Note that this should be a list.  Ie, do NOT use the following:
 519     (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
 520 Instead, use this:
 521     (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))"
 522   :type '(repeat (string))
 523   :group 'nnir)
 524
 525 (defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
 526   "*The prefix to remove from each file name returned by swish-e
 527 in order to get a group name (albeit with / instead of .).  This is a
 528 regular expression.
 529
 530 This variable is very similar to `nnir-glimpse-remove-prefix', except
 531 that it is for swish-e, not Glimpse."
 532   :type '(regexp)
 533   :group 'nnir)
 534
 535 ;; Namazu engine, see <URL:http://ww.namazu.org/>
 536
 537 (defcustom nnir-namazu-program "namazu"
 538   "*Name of Namazu search executable."
 539   :type '(string)
 540   :group 'nnir)
 541
 542 (defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/")
 543   "*Index directory for Namazu."
 544   :type '(directory)
 545   :group 'nnir)
 546
 547 (defcustom nnir-namazu-additional-switches '()
 548   "*A list of strings, to be given as additional arguments to namazu.
 549 The switches `-q', `-a', and `-s' are always used, very few other switches
 550 make any sense in this context.
 551
 552 Note that this should be a list.  Ie, do NOT use the following:
 553     (setq nnir-namazu-additional-switches \"-i -w\") ; wrong
 554 Instead, use this:
 555     (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
 556   :type '(repeat (string))
 557   :group 'nnir)
 558
 559 (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
 560   "*The prefix to remove from each file name returned by Namazu
 561 in order to get a group name (albeit with / instead of .).
 562
 563 This variable is very similar to `nnir-glimpse-remove-prefix', except
 564 that it is for Namazu, not Glimpse."
 565   :type '(directory)
 566   :group 'nnir)
 567
 568 ;;; Internal Variables:
 569
 570 (defvar nnir-current-query nil
 571   "Internal: stores current query (= group name).")
 572
 573 (defvar nnir-current-server nil
 574   "Internal: stores current server (does it ever change?).")
 575
 576 (defvar nnir-current-group-marked nil
 577   "Internal: stores current list of process-marked groups.")
 578
 579 (defvar nnir-artlist nil
 580   "Internal: stores search result.")
 581
 582 (defvar nnir-tmp-buffer " *nnir*"
 583   "Internal: temporary buffer.")
 584
 585 ;;; Code:
 586
 587 ;; Gnus glue.
 588
 589 (defun gnus-group-make-nnir-group (extra-parms query)
 590   "Create an nnir group.  Asks for query."
 591   (interactive "P\nsQuery: ")
 592   (let ((parms nil))
 593     (if extra-parms
 594         (setq parms (nnir-read-parms query))
 595       (setq parms (list (cons 'query query))))
 596     (gnus-group-read-ephemeral-group
 597      (concat "nnir:" (prin1-to-string parms)) '(nnir "") t
 598      (cons (current-buffer)
 599            gnus-current-window-configuration)
 600      nil)))
 601
 602 ;; Emacs 19 compatibility?
 603 (or (fboundp 'kbd) (defalias 'kbd 'read-kbd-macro))
 604
 605 (defun nnir-group-mode-hook ()
 606   (define-key gnus-group-mode-map
 607     (if (fboundp 'read-kbd-macro)
 608         (kbd "G G")
 609       "GG")                             ; XEmacs 19 compat
 610     'gnus-group-make-nnir-group))
 611 (add-hook 'gnus-group-mode-hook
 612           (lambda ()
 613             (unless (string-match "T-gnus" gnus-version)
 614               (nnir-group-mode-hook))))
 615
 616
 617
 618 ;; Summary mode commands.
 619
 620 (defun gnus-summary-nnir-goto-thread ()
 621   "Only applies to nnir groups.  Go to group this article came from
 622 and show thread that contains this article."
 623   (interactive)
 624   (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
 625     (error "Can't execute this command unless in nnir group."))
 626   (let* ((cur (gnus-summary-article-number))
 627          (backend-group (nnir-artlist-artitem-group nnir-artlist cur))
 628          (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
 629     (gnus-group-read-ephemeral-group
 630      backend-group
 631      nnir-mail-backend
 632      t                                  ; activate
 633      (cons (current-buffer)
 634            'summary)                    ; window config
 635      nil
 636      (list backend-number))
 637     (gnus-summary-limit (list backend-number))
 638     (gnus-summary-refer-thread)))
 639
 640 (if (fboundp 'eval-after-load)
 641     (eval-after-load "gnus-sum"
 642       '(define-key gnus-summary-goto-map
 643          "T" 'gnus-summary-nnir-goto-thread))
 644   (add-hook 'gnus-summary-mode-hook
 645             (function (lambda ()
 646                         (define-key gnus-summary-goto-map
 647                           "T" 'gnus-summary-nnir-goto-thread)))))
 648
 649
 650
 651 ;; Gnus backend interface functions.
 652
 653 (deffoo nnir-open-server (server &optional definitions)
 654   ;; Just set the server variables appropriately.
 655   (nnoo-change-server 'nnir server definitions))
 656
 657 (deffoo nnir-request-group (group &optional server fast)
 658   "GROUP is the query string."
 659   (nnir-possibly-change-server server)
 660   ;; Check for cache and return that if appropriate.
 661   (if (and (equal group nnir-current-query)
 662            (equal gnus-group-marked nnir-current-group-marked)
 663            (or (null server)
 664                (equal server nnir-current-server)))
 665       nnir-artlist
 666     ;; Cache miss.
 667     (setq nnir-artlist (nnir-run-query group))
 668     (save-excursion
 669       (set-buffer nntp-server-buffer)
 670       (if (zerop (length nnir-artlist))
 671           (progn
 672             (setq nnir-current-query nil
 673                   nnir-current-server nil
 674                   nnir-current-group-marked nil
 675                   nnir-artlist nil)
 676             (nnheader-report 'nnir "Search produced empty results."))
 677         ;; Remember data for cache.
 678         (setq nnir-current-query group)
 679         (when server (setq nnir-current-server server))
 680         (setq nnir-current-group-marked gnus-group-marked)
 681         (nnheader-insert "211 %d %d %d %s\n"
 682                          (nnir-artlist-length nnir-artlist) ; total #
 683                          1              ; first #
 684                          (nnir-artlist-length nnir-artlist) ; last #
 685                          group)))))     ; group name
 686
 687 (deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
 688   (save-excursion
 689     (let ((artlist (copy-sequence articles))
 690           (idx 1)
 691           (art nil)
 692           (artitem nil)
 693           (artgroup nil) (artno nil)
 694           (artrsv nil)
 695           (artfullgroup nil)
 696           (novitem nil)
 697           (novdata nil)
 698           (foo nil))
 699       (while (not (null artlist))
 700         (setq art (car artlist))
 701         (or (numberp art)
 702             (nnheader-report
 703              'nnir
 704              "nnir-retrieve-headers doesn't grok message ids: %s"
 705              art))
 706         (setq artitem (nnir-artlist-article nnir-artlist art))
 707         (setq artrsv (nnir-artitem-rsv artitem))
 708         (setq artgroup (nnir-artitem-group artitem))
 709         (setq artno (nnir-artitem-number artitem))
 710         (setq artfullgroup (nnir-group-full-name artgroup))
 711         ;; retrieve NOV or HEAD data for this article, transform into
 712         ;; NOV data and prepend to `novdata'
 713         (set-buffer nntp-server-buffer)
 714         (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil))
 715           (nov
 716            (goto-char (point-min))
 717            (setq novitem (nnheader-parse-nov))
 718            (unless novitem
 719              (pop-to-buffer nntp-server-buffer)
 720              (error
 721               "nnheader-parse-nov returned nil for article %s in group %s"
 722               artno artfullgroup)))
 723           (headers
 724            (goto-char (point-min))
 725            (setq novitem (nnheader-parse-head))
 726            (unless novitem
 727              (pop-to-buffer nntp-server-buffer)
 728              (error
 729               "nnheader-parse-head returned nil for article %s in group %s"
 730               artno artfullgroup)))
 731           (t (nnheader-report 'nnir "Don't support header type %s." foo)))
 732         ;; replace article number in original group with article number
 733         ;; in nnir group
 734         (mail-header-set-number novitem idx)
 735         (mail-header-set-from novitem
 736                               (mail-header-from novitem))
 737         (mail-header-set-subject
 738          novitem
 739          (format "[%d: %s/%d] %s"
 740                  artrsv artgroup artno
 741                  (mail-header-subject novitem)))
 742         ;;-(mail-header-set-extra novitem nil)
 743         (push novitem novdata)
 744         (setq artlist (cdr artlist))
 745         (setq idx (1+ idx)))
 746       (setq novdata (nreverse novdata))
 747       (set-buffer nntp-server-buffer) (erase-buffer)
 748       (mapcar 'nnheader-insert-nov novdata)
 749       'nov)))
 750
 751 (deffoo nnir-request-article (article
 752                               &optional group server to-buffer)
 753   (save-excursion
 754     (let* ((artitem (nnir-artlist-article nnir-artlist
 755                                           article))
 756            (artgroup (nnir-artitem-group artitem))
 757            (artno (nnir-artitem-number artitem))
 758            ;; Bug?
 759            ;; Why must we bind nntp-server-buffer here?  It won't
 760            ;; work if `buf' is used, say.  (Of course, the set-buffer
 761            ;; line below must then be updated, too.)
 762            (nntp-server-buffer (or to-buffer nntp-server-buffer)))
 763       (set-buffer nntp-server-buffer)
 764       (erase-buffer)
 765       (message "Requesting article %d from group %s"
 766                artno
 767                (nnir-group-full-name artgroup))
 768       (gnus-request-article artno (nnir-group-full-name artgroup)
 769                             nntp-server-buffer)
 770       (cons artgroup artno))))
 771
 772
 773 (nnoo-define-skeleton nnir)
 774
 775 ;;; Search Engine Interfaces:
 776
 777 ;; Glimpse interface.
 778 (defun nnir-run-glimpse (query &optional group)
 779   "Run given query against glimpse.  Returns a vector of (group name, file name)
 780 pairs (also vectors, actually)."
 781   (save-excursion
 782     (let ((artlist nil)
 783           (groupspec (cdr (assq 'group query)))
 784           (qstring (cdr (assq 'query query))))
 785       (when (and group groupspec)
 786         (error (concat "It does not make sense to use a group spec"
 787                        " with process-marked groups.")))
 788       (when group
 789         (setq groupspec (gnus-group-real-name group)))
 790       (set-buffer (get-buffer-create nnir-tmp-buffer))
 791       (erase-buffer)
 792       (if groupspec
 793           (message "Doing glimpse query %s on %s..." query groupspec)
 794         (message "Doing glimpse query %s..." query))
 795       (let* ((cp-list
 796               `( ,nnir-glimpse-program
 797                  nil                    ; input from /dev/null
 798                  t                      ; output
 799                  nil                    ; don't redisplay
 800                  "-H" ,nnir-glimpse-home ; search home dir
 801                  "-W"                   ; match pattern in file
 802                  "-l" "-y"              ; misc options
 803                  ,@nnir-glimpse-additional-switches
 804                  "-F" ,nnir-glimpse-remove-prefix ; restrict output to mail
 805                  ,qstring               ; the query, in glimpse format
 806                 ))
 807              (exitstatus
 808               (progn
 809                 (message "%s args: %s" nnir-glimpse-program
 810                          (mapconcat 'identity (cddddr cp-list) " "))
 811                 (apply 'call-process cp-list))))
 812         (unless (or (null exitstatus)
 813                     (zerop exitstatus))
 814           (nnheader-report 'nnir "Couldn't run glimpse: %s" exitstatus)
 815           ;; Glimpse failure reason is in this buffer, show it if
 816           ;; the user wants it.
 817           (when (> gnus-verbose 6)
 818             (display-buffer nnir-tmp-buffer))))
 819       (when groupspec
 820         (keep-lines groupspec))
 821       (if groupspec
 822           (message "Doing glimpse query %s on %s...done" query groupspec)
 823         (message "Doing glimpse query %s...done" query))
 824       (sit-for 0)
 825       ;; CCC: The following work of extracting group name and article
 826       ;; number from the Glimpse output can probably better be done by
 827       ;; just going through the buffer once, and plucking out the
 828       ;; right information from each line.
 829       ;; remove superfluous stuff from glimpse output
 830       (goto-char (point-min))
 831       (delete-non-matching-lines "/[0-9]+$")
 832       ;;(delete-matching-lines "\\.overview~?$")
 833       (goto-char (point-min))
 834       (while (re-search-forward (concat "^" nnir-glimpse-remove-prefix) nil t)
 835         (replace-match ""))
 836       ;; separate group name from article number with \t
 837       ;; XEmacs compatible version
 838       (goto-char (point-max))
 839       (while (re-search-backward "/[0-9]+$" nil t)
 840         (delete-char 1 nil)
 841         (insert-char ?\t 1))
 842 ; Emacs compatible version
 843 ;      (goto-char (point-min))
 844 ;      (while (re-search-forward "\\(/\\)[0-9]+$" nil t)
 845 ;        (replace-match "\t" t t nil 1))
 846       ;; replace / with . in group names
 847       (subst-char-in-region (point-min) (point-max) ?/ ?. t)
 848       ;; massage buffer to contain some Lisp;
 849       ;; this depends on the artlist encoding internals
 850       ;; maybe this dependency should be removed?
 851       (goto-char (point-min))
 852       (while (not (eobp))
 853         (insert "[\"")
 854         (skip-chars-forward "^\t")
 855         (insert "\" ")
 856         (end-of-line)
 857         (insert " 1000 ]")              ; 1000 = score
 858         (forward-line 1))
 859       (insert "])\n")
 860       (goto-char (point-min))
 861       (insert "(setq artlist [\n")
 862       (eval-buffer)
 863       (sort* artlist
 864              (function (lambda (x y)
 865                          (if (string-lessp (nnir-artitem-group x)
 866                                            (nnir-artitem-group y))
 867                              t
 868                            (< (nnir-artitem-number x)
 869                               (nnir-artitem-number y))))))
 870       )))
 871
 872 ;; freeWAIS-sf interface.
 873 (defun nnir-run-waissearch (query &optional group)
 874   "Run given query agains waissearch.  Returns vector of (group name, file name)
 875 pairs (also vectors, actually)."
 876   (when group
 877     (error "The freeWAIS-sf backend cannot search specific groups."))
 878   (save-excursion
 879     (let ((qstring (cdr (assq 'query query)))
 880           (artlist nil)
 881           (score nil) (artno nil) (dirnam nil) (group nil))
 882       (set-buffer (get-buffer-create nnir-tmp-buffer))
 883       (erase-buffer)
 884       (message "Doing WAIS query %s..." query)
 885       (call-process nnir-wais-program
 886                     nil                 ; input from /dev/null
 887                     t                   ; output to current buffer
 888                     nil                 ; don't redisplay
 889                     "-d" nnir-wais-database ; database to search
 890                     qstring)
 891       (message "Massaging waissearch output...")
 892       ;; remove superfluous lines
 893       (keep-lines "Score:")
 894       ;; extract data from result lines
 895       (goto-char (point-min))
 896       (while (re-search-forward
 897               "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t)
 898         (setq score (match-string 1)
 899               artno (match-string 2)
 900               dirnam (match-string 3))
 901         (unless (string-match nnir-wais-remove-prefix dirnam)
 902           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
 903                            dirnam nnir-wais-remove-prefix))
 904         (setq group (substitute ?. ?/ (replace-match "" t t dirnam)))
 905         (push (vector group
 906                       (string-to-int artno)
 907                       (string-to-int score))
 908               artlist))
 909       (message "Massaging waissearch output...done")
 910       (apply 'vector
 911              (sort* artlist
 912                     (function (lambda (x y)
 913                                 (> (nnir-artitem-rsv x)
 914                                    (nnir-artitem-rsv y)))))))))
 915
 916 ;; EWS (Excite for Web Servers) interface
 917 (defun nnir-run-excite-search (query &optional group)
 918   "Run a given query against EWS.  Returns vector of (group name, file name)
 919 pairs (also vectors, actually)."
 920   (when group
 921     (error "Searching specific groups not implemented for EWS."))
 922   (save-excursion
 923     (let ((qstring (cdr (assq 'query query)))
 924           artlist group article-num article)
 925       (setq nnir-current-query query)
 926       (set-buffer (get-buffer-create nnir-tmp-buffer))
 927       (erase-buffer)
 928       (message "Doing EWS query %s..." qstring)
 929       (call-process nnir-excite-aquery-program
 930                     nil                 ; input from /dev/null
 931                     t                   ; output to current buffer
 932                     nil                 ; don't redisplay
 933                     nnir-excite-collection
 934                     (if (string= (substring qstring 0 1) "(")
 935                         qstring
 936                       (format "(concept %s)" qstring)))
 937       (message "Gathering query output...")
 938
 939       (goto-char (point-min))
 940       (while (re-search-forward
 941               "^[0-9]+\\s-[0-9]+\\s-[0-9]+\\s-\\(\\S-*\\)" nil t)
 942         (setq article (match-string 1))
 943         (unless (string-match
 944                  (concat "^" (regexp-quote nnir-excite-remove-prefix)
 945                          "\\(.*\\)/\\([0-9]+\\)") article)
 946           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
 947                            article nnir-excite-remove-prefix))
 948         (setq group (substitute ?. ?/ (match-string 1 article)))
 949         (setq article-num (match-string 2 article))
 950         (setq artlist (vconcat artlist (vector (vector group
 951                                                        (string-to-int article-num)
 952                                                        1000)))))
 953       (message "Gathering query output...done")
 954       artlist)))
 955
 956 ;; IMAP interface.  The following function is Copyright (C) 1998 Simon
 957 ;; Josefsson <jas@pdc.kth.se>.
 958 ;; todo:
 959 ;; nnir invokes this two (2) times???!
 960 ;; we should not use nnimap at all but open our own server connection
 961 ;; we should not LIST * but use nnimap-list-pattern from defs
 962 ;; send queries as literals
 963 ;; handle errors
 964
 965 (eval-when-compile
 966   (defvar nnimap-server-buffer))
 967
 968 (defun nnir-run-imap (query &optional group)
 969   (require 'imap)
 970   (require 'nnimap)
 971   (unless group
 972     (error "Must specify groups for IMAP searching."))
 973   (save-excursion
 974     (let ((qstring (cdr (assq 'query query)))
 975           (server (cadr nnir-mail-backend))
 976           (defs (caddr nnir-mail-backend))
 977           artlist buf)
 978       (message "Opening server %s" server)
 979       (condition-case ()
 980           (when (nnimap-open-server server defs) ;; xxx
 981             (setq buf nnimap-server-buffer) ;; xxx
 982             (message "Searching %s..." group)
 983             (let ((arts 0)
 984                   (mbx (gnus-group-real-name group)))
 985               (when (imap-mailbox-select mbx nil buf)
 986                 (mapcar
 987                  (lambda (artnum)
 988                    (push (vector mbx artnum 1) artlist)
 989                    (setq arts (1+ arts)))
 990                  (imap-search (concat "TEXT \"" qstring "\"") buf))
 991                 (message "Searching %s... %d matches" mbx arts)))
 992             (message "Searching %s...done" group))
 993         (quit nil))
 994       (reverse artlist))))
 995
 996 ;; Swish++ interface.  The following function is Copyright (C) 2000,
 997 ;; 2001 Christoph Conrad <christoph.conrad@gmx.de>.
 998 ;; -cc- Todo
 999 ;; Search by
1000 ;; - group
1001 ;; Sort by
1002 ;; - rank (default)
1003 ;; - article number
1004 ;; - file size
1005 ;; - group
1006 (defun nnir-run-swish++ (query &optional group)
1007   "Run given query against swish++.
1008 Returns a vector of (group name, file name) pairs (also vectors,
1009 actually).
1010
1011 Tested with swish++ 4.7 on GNU/Linux and with with swish++ 5.0b2 on
1012 Windows NT 4.0."
1013
1014   (when group
1015     (error "The swish++ backend cannot search specific groups."))
1016
1017   (save-excursion
1018     (let ( (qstring (cdr (assq 'query query)))
1019            (groupspec (cdr (assq 'group query)))
1020            (artlist nil)
1021            (score nil) (artno nil) (dirnam nil) (group nil) )
1022
1023       (when (equal "" qstring)
1024         (error "swish++: You didn't enter anything."))
1025
1026       (set-buffer (get-buffer-create nnir-tmp-buffer))
1027       (erase-buffer)
1028
1029       (if groupspec
1030           (message "Doing swish++ query %s on %s..." qstring groupspec)
1031         (message "Doing swish++ query %s..." qstring))
1032
1033       (let* ((cp-list `( ,nnir-swish++-program
1034                          nil            ; input from /dev/null
1035                          t              ; output
1036                          nil            ; don't redisplay
1037                          "--config-file" ,nnir-swish++-configuration-file
1038                          ,@nnir-swish++-additional-switches
1039                          ,qstring       ; the query, in swish++ format
1040                          ))
1041              (exitstatus
1042               (progn
1043                 (message "%s args: %s" nnir-swish++-program
1044                          (mapconcat 'identity (cddddr cp-list) " "));; ???
1045                 (apply 'call-process cp-list))))
1046         (unless (or (null exitstatus)
1047                     (zerop exitstatus))
1048           (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus)
1049           ;; swish++ failure reason is in this buffer, show it if
1050           ;; the user wants it.
1051           (when (> gnus-verbose 6)
1052             (display-buffer nnir-tmp-buffer))))
1053
1054       ;; The results are output in the format of:
1055       ;; V 4.7 Linux
1056       ;; rank relative-path-name file-size file-title
1057       ;; V 5.0b2:
1058       ;; rank relative-path-name file-size topic??
1059       ;; where rank is an integer from 1 to 100.
1060       (goto-char (point-min))
1061       (while (re-search-forward
1062               "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
1063         (setq score (match-string 1)
1064               artno (file-name-nondirectory (match-string 2))
1065               dirnam (file-name-directory (match-string 2)))
1066
1067         ;; don't match directories
1068         (when (string-match "^[0-9]+$" artno)
1069           (when (not (null dirnam))
1070
1071             ; maybe limit results to matching groups.
1072             (when (or (not groupspec)
1073                       (string-match groupspec dirnam))
1074
1075               ;; remove nnir-swish++-remove-prefix from beginning of dirname
1076               (when (string-match (concat "^" nnir-swish++-remove-prefix)
1077                                   dirnam)
1078                 (setq dirnam (replace-match "" t t dirnam)))
1079
1080               (setq dirnam (substring dirnam 0 -1))
1081               ;; eliminate all ".", "/", "\" from beginning. Always matches.
1082               (string-match "^[./\\]*\\(.*\\)$" dirnam)
1083               ;; "/" -> "."
1084               (setq group (substitute ?. ?/ (match-string 1 dirnam)))
1085               ;; "\\" -> "."
1086               (setq group (substitute ?. ?\\ group))
1087
1088               (push (vector group
1089                             (string-to-int artno)
1090                             (string-to-int score))
1091                     artlist)))))
1092
1093       (message "Massaging swish++ output...done")
1094
1095       ;; Sort by score
1096       (apply 'vector
1097              (sort* artlist
1098                     (function (lambda (x y)
1099                                 (> (nnir-artitem-rsv x)
1100                                    (nnir-artitem-rsv y)))))))))
1101
1102 ;; Swish-E interface.  The following function is Copyright (C) 2000,
1103 ;; 2001 by Christoph Conrad <christoph.conrad@gmx.de>.
1104 (defun nnir-run-swish-e (query &optional group)
1105   "Run given query against swish-e.
1106 Returns a vector of (group name, file name) pairs (also vectors,
1107 actually).
1108
1109 Tested with swish-e-2.0.1 on Windows NT 4.0."
1110
1111   ;; swish-e crashes with empty parameter to "-w" on commandline...
1112   (when group
1113     (error "The swish-e backend cannot search specific groups."))
1114
1115   (save-excursion
1116     (let ( (qstring (cdr (assq 'query query)))
1117            (artlist nil)
1118            (score nil) (artno nil) (dirnam nil) (group nil) )
1119
1120       (when (equal "" qstring)
1121         (error "swish-e: You didn't enter anything."))
1122
1123       (set-buffer (get-buffer-create nnir-tmp-buffer))
1124       (erase-buffer)
1125
1126       (message "Doing swish-e query %s..." query)
1127       (let* ((cp-list `( ,nnir-swish-e-program
1128                          nil            ; input from /dev/null
1129                          t              ; output
1130                          nil            ; don't redisplay
1131                          "-f" ,nnir-swish-e-index-file
1132                          ,@nnir-swish-e-additional-switches
1133                          "-w"
1134                          ,qstring       ; the query, in swish-e format
1135                          ))
1136              (exitstatus
1137               (progn
1138                 (message "%s args: %s" nnir-swish-e-program
1139                          (mapconcat 'identity (cddddr cp-list) " "))
1140                 (apply 'call-process cp-list))))
1141         (unless (or (null exitstatus)
1142                     (zerop exitstatus))
1143           (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus)
1144           ;; swish-e failure reason is in this buffer, show it if
1145           ;; the user wants it.
1146           (when (> gnus-verbose 6)
1147             (display-buffer nnir-tmp-buffer))))
1148
1149       ;; The results are output in the format of:
1150       ;; rank path-name file-title file-size
1151       (goto-char (point-min))
1152       (while (re-search-forward
1153               "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
1154         (setq score (match-string 1)
1155               artno (match-string 3)
1156               dirnam (file-name-directory (match-string 2)))
1157
1158         ;; don't match directories
1159         (when (string-match "^[0-9]+$" artno)
1160           (when (not (null dirnam))
1161
1162             ;; remove nnir-swish-e-remove-prefix from beginning of dirname
1163             (when (string-match (concat "^" nnir-swish-e-remove-prefix)
1164                                 dirnam)
1165               (setq dirnam (replace-match "" t t dirnam)))
1166
1167             (setq dirnam (substring dirnam 0 -1))
1168             ;; eliminate all ".", "/", "\" from beginning. Always matches.
1169             (string-match "^[./\\]*\\(.*\\)$" dirnam)
1170             ;; "/" -> "."
1171             (setq group (substitute ?. ?/ (match-string 1 dirnam)))
1172             ;; Windows "\\" -> "."
1173             (setq group (substitute ?. ?\\ group))
1174
1175             (push (vector group
1176                           (string-to-int artno)
1177                           (string-to-int score))
1178                   artlist))))
1179
1180       (message "Massaging swish-e output...done")
1181
1182       ;; Sort by score
1183       (apply 'vector
1184              (sort* artlist
1185                     (function (lambda (x y)
1186                                 (> (nnir-artitem-rsv x)
1187                                    (nnir-artitem-rsv y)))))))))
1188
1189 ;; Namazu interface
1190 (defun nnir-run-namazu (query &optional group)
1191   "Run given query against Namazu.  Returns a vector of (group name, file name)
1192 pairs (also vectors, actually).
1193
1194 Tested with Namazu 2.0.6 on a GNU/Linux system."
1195   (when group
1196     (error "The Namazu backend cannot search specific groups"))
1197   (save-excursion
1198     (let (
1199           (artlist nil)
1200           (qstring (cdr (assq 'query query)))
1201           (score nil)
1202           (group nil)
1203           (article nil)
1204           )
1205       (set-buffer (get-buffer-create nnir-tmp-buffer))
1206       (erase-buffer)
1207       (let* ((cp-list
1208               `( ,nnir-namazu-program
1209                  nil              ; input from /dev/null
1210                  t                ; output
1211                  nil              ; don't redisplay
1212                  "-q"             ; don't be verbose
1213                  "-a"             ; show all matches
1214                  "-s"             ; use short format
1215                  ,@nnir-namazu-additional-switches
1216                  ,qstring         ; the query, in namazu format
1217                  ,nnir-namazu-index-directory ; index directory
1218                  ))
1219              (exitstatus
1220               (let ((process-environment (copy-sequence process-environment)))
1221                 ;; Disable locale.
1222                 (dolist (env process-environment)
1223                   (when (string-match "\
1224 \\`\\(L\\(ANG\\|C_\\(ALL\\|CTYPE\\|COLLATE\\|TIME\\|NUMERIC\\|MONETARY\\|MESSAGES\\)\\)\\)=" env)
1225                     (setenv (match-string 1 env) nil)))
1226                 (setenv "LANG" "C")
1227                 (message "%s args: %s" nnir-namazu-program
1228                          (mapconcat 'identity (cddddr cp-list) " "))
1229                 (apply 'call-process cp-list))))
1230         (unless (or (null exitstatus)
1231                     (zerop exitstatus))
1232           (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus)
1233           ;; Namazu failure reason is in this buffer, show it if
1234           ;; the user wants it.
1235           (when (> gnus-verbose 6)
1236             (display-buffer nnir-tmp-buffer))))
1237
1238       ;; Namazu output looks something like this:
1239       ;; 2. Re: Gnus agent expire broken (score: 55)
1240       ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes)
1241
1242       (goto-char (point-min))
1243       (while (re-search-forward
1244               "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
1245               nil t)
1246         (setq score (match-string 3)
1247               group (file-name-directory (match-string 4))
1248               article (file-name-nondirectory (match-string 4)))
1249
1250         ;; make sure article and group is sane
1251         (when (and (string-match "^[0-9]+$" article)
1252                    (not (null group)))
1253           (when (string-match (concat "^" nnir-namazu-remove-prefix) group)
1254             (setq group (replace-match "" t t group)))
1255
1256           ;; remove trailing slash from groupname
1257           (setq group (substring group 0 -1))
1258
1259           ;; stuff results into artlist vector
1260           (push (vector (substitute ?. ?/ group)
1261                         (string-to-int article)
1262                         (string-to-int score)) artlist)))
1263
1264       ;; sort artlist by score
1265       (apply 'vector
1266              (sort* artlist
1267                     (function (lambda (x y)
1268                                 (> (nnir-artitem-rsv x)
1269                                    (nnir-artitem-rsv y)))))))))
1270
1271 ;;; Util Code:
1272
1273 (defun nnir-read-parms (query)
1274   "Reads additional search parameters according to `nnir-engines'."
1275   (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
1276     (cons (cons 'query query)
1277           (mapcar 'nnir-read-parm parmspec))))
1278
1279 (defun nnir-read-parm (parmspec)
1280   "Reads a single search parameter.
1281 `parmspec' is a cons cell, the car is a symbol, the cdr is a prompt."
1282   (let ((sym (car parmspec))
1283         (prompt (cdr parmspec)))
1284     (cons sym (read-string prompt))))
1285
1286 (defun nnir-run-query (query)
1287   "Invoke appropriate search engine function (see `nnir-engines').
1288 If some groups were process-marked, run the query for each of the groups
1289 and concat the results."
1290   (let ((search-func (cadr (assoc nnir-search-engine nnir-engines)))
1291         (q (car (read-from-string query))))
1292     (if gnus-group-marked
1293         (apply 'append
1294                (mapcar (lambda (x)
1295                          (funcall search-func q x))
1296                        gnus-group-marked))
1297       (funcall search-func q nil))))
1298
1299 (defun nnir-group-full-name (shortname)
1300   "For the given group name, return a full Gnus group name.
1301 The Gnus backend/server information is added."
1302   (gnus-group-prefixed-name shortname nnir-mail-backend))
1303
1304 (defun nnir-possibly-change-server (server)
1305   (unless (and server (nnir-server-opened server))
1306     (nnir-open-server server)))
1307
1308
1309 ;; Data type article list.
1310
1311 (defun nnir-artlist-length (artlist)
1312   "Returns number of articles in artlist."
1313   (length artlist))
1314
1315 (defun nnir-artlist-article (artlist n)
1316   "Returns from ARTLIST the Nth artitem (counting starting at 1)."
1317   (elt artlist (1- n)))
1318
1319 (defun nnir-artitem-group (artitem)
1320   "Returns the group from the ARTITEM."
1321   (elt artitem 0))
1322
1323 (defun nnir-artlist-artitem-group (artlist n)
1324   "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
1325   (nnir-artitem-group (nnir-artlist-article artlist n)))
1326
1327 (defun nnir-artitem-number (artitem)
1328   "Returns the number from the ARTITEM."
1329   (elt artitem 1))
1330
1331 (defun nnir-artlist-artitem-number (artlist n)
1332   "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
1333   (nnir-artitem-number (nnir-artlist-article artlist n)))
1334
1335 (defun nnir-artitem-rsv (artitem)
1336   "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
1337   (elt artitem 2))
1338
1339 (defun nnir-artlist-artitem-rsv (artlist n)
1340   "Returns from ARTLIST the Retrieval Status Value of the Nth artitem
1341 (counting from 1)."
1342   (nnir-artitem-rsv (nnir-artlist-article artlist n)))
1343
1344 ;; unused?
1345 (defun nnir-artlist-groups (artlist)
1346   "Returns a list of all groups in the given ARTLIST."
1347   (let ((res nil)
1348         (with-dups nil))
1349     ;; from each artitem, extract group component
1350     (setq with-dups (mapcar 'nnir-artitem-group artlist))
1351     ;; remove duplicates from above
1352     (mapcar (function (lambda (x) (add-to-list 'res x)))
1353             with-dups)
1354     res))
1355
1356
1357 ;; The end.
1358 (provide 'nnir)