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.1.2.1 2001/09/04 10:32:55 tsuchiya Exp $
   5
   6 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
   7 ;; Keywords: news, mail, searching, ir, glimpse, wais, Namazu
   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 ;; 3. Namazu
 208 ;;
 209 ;;
 210
 211 ;; Developer information:
 212
 213 ;; I have tried to make the code expandable.  Basically, it is divided
 214 ;; into two layers.  The upper layer is somewhat like the `nnvirtual'
 215 ;; or `nnkiboze' backends: given a specification of what articles to
 216 ;; show from another backend, it creates a group containing exactly
 217 ;; those articles.  The lower layer issues a query to a search engine
 218 ;; and produces such a specification of what articles to show from the
 219 ;; other backend.
 220
 221 ;; The interface between the two layers consists of the single
 222 ;; function `nnir-run-query', which just selects the appropriate
 223 ;; function for the search engine one is using.  The input to
 224 ;; `nnir-run-query' is a string, representing the query as input by
 225 ;; the user.  The output of `nnir-run-query' is supposed to be a
 226 ;; vector, each element of which should in turn be a three-element
 227 ;; vector.  The first element should be group name of the article, the
 228 ;; second element should be the article number, and the third element
 229 ;; should be the Retrieval Status Value (RSV) as returned from the
 230 ;; search engine.  An RSV is the score assigned to the document by the
 231 ;; search engine.  For Boolean search engines like Glimpse, the RSV is
 232 ;; always 1000 (or 1 or 100, or whatever you like).
 233
 234 ;; The sorting order of the articles in the summary buffer created by
 235 ;; nnir is based on the order of the articles in the above mentioned
 236 ;; vector, so that's where you can do the sorting you'd like.  Maybe
 237 ;; it would be nice to have a way of displaying the search result
 238 ;; sorted differently?
 239
 240 ;; So what do you need to do when you want to add another search
 241 ;; engine?  You write a function that executes the query.  Temporary
 242 ;; data from the search engine can be put in `nnir-tmp-buffer'.  This
 243 ;; function should return the list of articles as a vector, as
 244 ;; described above.  Then, you need to register this backend in
 245 ;; `nnir-engines'.  Then, users can choose the backend by setting
 246 ;; `nnir-search-engine'.
 247
 248 ;; Todo, or future ideas:
 249
 250 ;; * Make it so that Glimpse can also be called without `-F'.
 251 ;;
 252 ;; * It should be possible to restrict search to certain groups.
 253 ;;
 254 ;; * There is currently no error checking.
 255 ;;
 256 ;; * The summary buffer display is currently really ugly, with all the
 257 ;;   added information in the subjects.  How could I make this
 258 ;;   prettier?
 259 ;;
 260 ;; * A function which can be called from an nnir summary buffer which
 261 ;;   teleports you into the group the current article came from and
 262 ;;   shows you the whole thread this article is part of.
 263 ;;   Implementation suggestions?
 264 ;;   (1998-07-24: There is now a preliminary implementation, but
 265 ;;   it is much too slow and quite fragile.)
 266 ;;
 267 ;; * Support other mail backends.  In particular, probably quite a few
 268 ;;   people use nnfolder.  How would one go about searching nnfolders
 269 ;;   and producing the right data needed?  The group name and the RSV
 270 ;;   are simple, but what about the article number?
 271 ;;
 272 ;; * Support compressed mail files.  Probably, just stripping off the
 273 ;;   `.gz' or `.Z' file name extension is sufficient.
 274 ;;
 275 ;; * Support a find/grep combination.
 276 ;;
 277 ;; * At least for imap, the query is performed twice.
 278 ;;
 279 ;; * Support multiple mail backends.  The information that is needed
 280 ;;   by nnir could be put in the server parameters.  (Use sensible
 281 ;;   default values, though: include the name of the backend in the
 282 ;;   default value such that people do not have to mess with the
 283 ;;   server parameters if they don't want to.)  It is not clear how to
 284 ;;   do the user interface, though.  Hm.  Maybe offer the user a
 285 ;;   completable list of backends to search?  Or use the
 286 ;;   process-marked groups to find out which backends to search?  Or
 287 ;;   always search all backends?
 288 ;;
 289
 290 ;; Have you got other ideas?
 291
 292 ;;; Setup Code:
 293
 294 (defconst nnir-version "$Id: nnir.el,v 1.1.2.1 2001/09/04 10:32:55 tsuchiya Exp $"
 295   "Version of NNIR.")
 296
 297 (require 'cl)
 298 (require 'nnoo)
 299 (require 'gnus-group)
 300 (require 'gnus-sum)
 301 (eval-and-compile
 302   (require 'gnus-util))
 303
 304 (nnoo-declare nnir)
 305 (nnoo-define-basics nnir)
 306
 307 (gnus-declare-backend "nnir" 'mail)
 308
 309 ;;; Developer Extension Variable:
 310
 311 (defvar nnir-engines
 312   '((glimpse nnir-run-glimpse
 313              ((group . "Group spec: ")))
 314     (namazu nnir-run-namazu
 315             ((group . "Group spec: ")))
 316     (wais    nnir-run-waissearch
 317              ())
 318     (excite  nnir-run-excite-search
 319              ())
 320     (imap    nnir-run-imap
 321              ())
 322     (swish++ nnir-run-swish++
 323              ((group . "Group spec: ")))
 324     (swish-e nnir-run-swish-e
 325              ((group . "Group spec: ")))
 326     (namazu nnir-run-namazu
 327             ()))
 328 "Alist of supported search engines.
 329 Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
 330 ENGINE is a symbol designating the searching engine.  FUNCTION is also
 331 a symbol, giving the function that does the search.  The third element
 332 ARGS is a list of cons pairs (PARAM . PROMPT).  When issuing a query,
 333 the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
 334
 335 The value of `nnir-search-engine' must be one of the ENGINE symbols.
 336 For example, use the following line for searching using freeWAIS-sf:
 337     (setq nnir-search-engine 'wais)
 338 Use the following line if you read your mail via IMAP and your IMAP
 339 server supports searching:
 340     (setq nnir-search-engine 'imap)
 341 Note that you have to set additional variables for most backends.  For
 342 example, the `wais' backend needs the variables `nnir-wais-program',
 343 `nnir-wais-database' and `nnir-wais-remove-prefix'.
 344
 345 Add an entry here when adding a new search engine.")
 346
 347 ;;; User Customizable Variables:
 348
 349 (defgroup nnir nil
 350   "Search nnmh and nnml groups in Gnus with Glimpse, freeWAIS-sf, Namazu,
 351 or EWS.")
 352
 353 ;; Mail backend.
 354
 355 ;; TODO:
 356 ;; If `nil', use server parameters to find out which server to search. CCC
 357 ;;
 358 (defcustom nnir-mail-backend '(nnml "")
 359   "*Specifies which backend should be searched.
 360 More precisely, this is used to determine from which backend to fetch the
 361 messages found.
 362
 363 This must be equal to an existing server, so maybe it is best to use
 364 something like the following:
 365     (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods))
 366 The above line works fine if the mail backend you want to search is
 367 the first element of gnus-secondary-select-methods (`nth' starts counting
 368 at zero)."
 369   :type '(sexp)
 370   :group 'nnir)
 371
 372 ;; Search engine to use.
 373
 374 (defcustom nnir-search-engine 'wais
 375   "*The search engine to use.  Must be a symbol.
 376 See `nnir-engines' for a list of supported engines, and for example
 377 settings of `nnir-search-engine'."
 378   :type '(sexp)
 379   :group 'nnir)
 380
 381 ;; Glimpse engine.
 382
 383 (defcustom nnir-glimpse-program "glimpse"
 384   "*Name of Glimpse executable."
 385   :type '(string)
 386   :group 'nnir)
 387
 388 (defcustom nnir-glimpse-home (getenv "HOME")
 389   "*Value of `-H' glimpse option.
 390 `~' and environment variables must be expanded, see the functions
 391 `expand-file-name' and `substitute-in-file-name'."
 392   :type '(directory)
 393   :group 'nnir)
 394
 395 (defcustom nnir-glimpse-remove-prefix (concat (getenv "HOME") "/Mail/")
 396   "*The prefix to remove from each file name returned by Glimpse
 397 in order to get a group name (albeit with / instead of .).  This is a
 398 regular expression.
 399
 400 For example, suppose that Glimpse returns file names such as
 401 \"/home/john/Mail/mail/misc/42\".  For this example, use the following
 402 setting:  (setq nnir-glimpse-remove-prefix \"/home/john/Mail/\")
 403 Note the trailing slash.  Removing this prefix gives \"mail/misc/42\".
 404 `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
 405 arrive at the correct group name, \"mail.misc\"."
 406   :type '(regexp)
 407   :group 'nnir)
 408
 409 (defcustom nnir-glimpse-additional-switches '("-i")
 410   "*A list of strings, to be given as additional arguments to glimpse.
 411 The switches `-H', `-W', `-l' and `-y' are always used -- calling
 412 glimpse without them does not make sense in our situation.
 413 Suggested elements to put here are `-i' and `-w'.
 414
 415 Note that this should be a list.  Ie, do NOT use the following:
 416     (setq nnir-glimpse-additional-switches \"-i -w\") ; wrong!
 417 Instead, use this:
 418     (setq nnir-glimpse-additional-switches '(\"-i\" \"-w\"))"
 419   :type '(repeat (string))
 420   :group 'nnir)
 421
 422 ;; Namazu engine.
 423
 424 (defcustom nnir-namazu-program "namazu"
 425   "*Name of Namazu executable."
 426   :type '(string)
 427   :group 'nnir)
 428
 429 (defcustom nnir-namazu-index (expand-file-name "Namazu/" (getenv "HOME"))
 430   "*Namazu index directory"
 431   :type '(directory)
 432   :group 'nnir)
 433
 434 (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
 435   "*The prefix to remove from each file name returned by Namazu
 436 in order to get a group name (albeit with / instead of .)."
 437   :type '(directory)
 438   :group 'nnir)
 439
 440 ;; freeWAIS-sf.
 441
 442 (defcustom nnir-wais-program "waissearch"
 443   "*Name of waissearch executable."
 444   :type '(string)
 445   :group 'nnir)
 446
 447 (defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
 448   "*Name of Wais database containing the mail.
 449
 450 Note that this should be a file name without extension.  For example,
 451 if you have a file /home/john/.wais/mail.fmt, use this:
 452     (setq nnir-wais-database \"/home/john/.wais/mail\")
 453 The string given here is passed to `waissearch -d' as-is."
 454   :type '(file)
 455   :group 'nnir)
 456
 457 (defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/")
 458   "*The prefix to remove from each directory name returned by waissearch
 459 in order to get a group name (albeit with / instead of .).  This is a
 460 regular expression.
 461
 462 This variable is similar to `nnir-glimpse-remove-prefix', only for Wais,
 463 not Glimpse."
 464   :type '(regexp)
 465   :group 'nnir)
 466
 467 ;; EWS (Excite for Web Servers) engine.
 468
 469 (defcustom nnir-excite-aquery-program "aquery.pl"
 470   "*Name of the EWS query program.  Should be `aquery.pl' or a path to same."
 471   :type '(string)
 472   :group 'nnir)
 473
 474 (defcustom nnir-excite-collection "Mail"
 475   "*Name of the EWS collection to search."
 476   :type '(string)
 477   :group 'nnir)
 478
 479 (defcustom nnir-excite-remove-prefix (concat (getenv "HOME") "/Mail/")
 480   "*The prefix to remove from each file name returned by EWS
 481 in order to get a group name (albeit with / instead of .).  This is a
 482 regular expression.
 483
 484 This variable is very similar to `nnir-glimpse-remove-prefix', except
 485 that it is for EWS, not Glimpse."
 486   :type '(regexp)
 487   :group 'nnir)
 488
 489 ;; Swish++.  Next three variables Copyright (C) 2000, 2001 Christoph
 490 ;; Conrad <christoph.conrad@gmx.de>.
 491 ;; Swish++ home page: http://homepage.mac.com/pauljlucas/software/swish/
 492
 493 (defcustom nnir-swish++-configuration-file
 494   (expand-file-name "~/Mail/swish++.conf")
 495   "*Configuration file for swish++."
 496   :type '(file)
 497   :group 'nnir)
 498
 499 (defcustom nnir-swish++-program "search"
 500   "*Name of swish++ search executable."
 501   :type '(string)
 502   :group 'nnir)
 503
 504 (defcustom nnir-swish++-additional-switches '()
 505     "*A list of strings, to be given as additional arguments to swish++.
 506
 507 Note that this should be a list.  Ie, do NOT use the following:
 508     (setq nnir-swish++-additional-switches \"-i -w\") ; wrong
 509 Instead, use this:
 510     (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
 511   :type '(repeat (string))
 512   :group 'nnir)
 513
 514 (defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
 515   "*The prefix to remove from each file name returned by swish++
 516 in order to get a group name (albeit with / instead of .).  This is a
 517 regular expression.
 518
 519 This variable is very similar to `nnir-glimpse-remove-prefix', except
 520 that it is for swish++, not Glimpse."
 521   :type '(regexp)
 522   :group 'nnir)
 523
 524 ;; Swish-E.  Next three variables Copyright (C) 2000 Christoph Conrad
 525 ;; <christoph.conrad@gmx.de>.
 526 ;; URL: http://sunsite.berkeley.edu/SWISH-E/
 527 ;; New version: http://www.boe.es/swish-e
 528
 529 (defcustom nnir-swish-e-index-file
 530   (expand-file-name "~/Mail/index.swish-e")
 531   "*Index file for swish-e."
 532   :type '(file)
 533   :group 'nnir)
 534
 535 (defcustom nnir-swish-e-program "swish-e"
 536   "*Name of swish-e search executable."
 537   :type '(string)
 538   :group 'nnir)
 539
 540 (defcustom nnir-swish-e-additional-switches '()
 541   "*A list of strings, to be given as additional arguments to swish-e.
 542
 543 Note that this should be a list.  Ie, do NOT use the following:
 544     (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
 545 Instead, use this:
 546     (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))"
 547   :type '(repeat (string))
 548   :group 'nnir)
 549
 550 (defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
 551   "*The prefix to remove from each file name returned by swish-e
 552 in order to get a group name (albeit with / instead of .).  This is a
 553 regular expression.
 554
 555 This variable is very similar to `nnir-glimpse-remove-prefix', except
 556 that it is for swish-e, not Glimpse."
 557   :type '(regexp)
 558   :group 'nnir)
 559
 560 ;; Namazu engine, see <URL:http://ww.namazu.org/>
 561
 562 (defcustom nnir-namazu-program "namazu"
 563   "*Name of Namazu search executable."
 564   :type '(string)
 565   :group 'nnir)
 566
 567 (defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/")
 568   "*Index directory for Namazu."
 569   :type '(directory)
 570   :group 'nnir)
 571
 572 (defcustom nnir-namazu-additional-switches '()
 573   "*A list of strings, to be given as additional arguments to namazu.
 574 The switches `-q', `-a', and `-s' are always used, very few other switches
 575 make any sense in this context.
 576
 577 Note that this should be a list.  Ie, do NOT use the following:
 578     (setq nnir-namazu-additional-switches \"-i -w\") ; wrong
 579 Instead, use this:
 580     (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
 581   :type '(repeat (string))
 582   :group 'nnir)
 583
 584 (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
 585   "*The prefix to remove from each file name returned by Namazu
 586 in order to get a group name (albeit with / instead of .).
 587
 588 This variable is very similar to `nnir-glimpse-remove-prefix', except
 589 that it is for Namazu, not Glimpse."
 590   :type '(directory)
 591   :group 'nnir)
 592
 593 ;;; Internal Variables:
 594
 595 (defvar nnir-current-query nil
 596   "Internal: stores current query (= group name).")
 597
 598 (defvar nnir-current-server nil
 599   "Internal: stores current server (does it ever change?).")
 600
 601 (defvar nnir-current-group-marked nil
 602   "Internal: stores current list of process-marked groups.")
 603
 604 (defvar nnir-artlist nil
 605   "Internal: stores search result.")
 606
 607 (defvar nnir-tmp-buffer " *nnir*"
 608   "Internal: temporary buffer.")
 609
 610 ;;; Code:
 611
 612 ;; Gnus glue.
 613
 614 (defun gnus-group-make-nnir-group (extra-parms query)
 615   "Create an nnir group.  Asks for query."
 616   (interactive "P\nsQuery: ")
 617   (let ((parms nil))
 618     (if extra-parms
 619         (setq parms (nnir-read-parms query))
 620       (setq parms (list (cons 'query query))))
 621     (gnus-group-read-ephemeral-group
 622      (concat "nnir:" (prin1-to-string parms)) '(nnir "") t
 623      (cons (current-buffer)
 624            gnus-current-window-configuration)
 625      nil)))
 626
 627 ;; Emacs 19 compatibility?
 628 (or (fboundp 'kbd) (defalias 'kbd 'read-kbd-macro))
 629
 630 (defun nnir-group-mode-hook ()
 631   (define-key gnus-group-mode-map
 632     (if (fboundp 'read-kbd-macro)
 633         (kbd "G G")
 634       "GG")                             ; XEmacs 19 compat
 635     'gnus-group-make-nnir-group))
 636 (add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook)
 637
 638
 639
 640 ;; Summary mode commands.
 641
 642 (defun gnus-summary-nnir-goto-thread ()
 643   "Only applies to nnir groups.  Go to group this article came from
 644 and show thread that contains this article."
 645   (interactive)
 646   (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
 647     (error "Can't execute this command unless in nnir group."))
 648   (let* ((cur (gnus-summary-article-number))
 649          (backend-group (nnir-artlist-artitem-group nnir-artlist cur))
 650          (backend-number (nnir-artlist-artitem-number nnir-artlist cur)))
 651     (gnus-group-read-ephemeral-group
 652      backend-group
 653      nnir-mail-backend
 654      t                                  ; activate
 655      (cons (current-buffer)
 656            'summary)                    ; window config
 657      nil
 658      (list backend-number))
 659     (gnus-summary-limit (list backend-number))
 660     (gnus-summary-refer-thread)))
 661
 662 (if (fboundp 'eval-after-load)
 663     (eval-after-load "gnus-sum"
 664       '(define-key gnus-summary-goto-map
 665          "T" 'gnus-summary-nnir-goto-thread))
 666   (add-hook 'gnus-summary-mode-hook
 667             (function (lambda ()
 668                         (define-key gnus-summary-goto-map
 669                           "T" 'gnus-summary-nnir-goto-thread)))))
 670
 671
 672
 673 ;; Gnus backend interface functions.
 674
 675 (deffoo nnir-open-server (server &optional definitions)
 676   ;; Just set the server variables appropriately.
 677   (nnoo-change-server 'nnir server definitions))
 678
 679 (deffoo nnir-request-group (group &optional server fast)
 680   "GROUP is the query string."
 681   (nnir-possibly-change-server server)
 682   ;; Check for cache and return that if appropriate.
 683   (if (and (equal group nnir-current-query)
 684            (equal gnus-group-marked nnir-current-group-marked)
 685            (or (null server)
 686                (equal server nnir-current-server)))
 687       nnir-artlist
 688     ;; Cache miss.
 689     (setq nnir-artlist (nnir-run-query group))
 690     (save-excursion
 691       (set-buffer nntp-server-buffer)
 692       (if (zerop (length nnir-artlist))
 693           (progn
 694             (setq nnir-current-query nil
 695                   nnir-current-server nil
 696                   nnir-current-group-marked nil
 697                   nnir-artlist nil)
 698             (nnheader-report 'nnir "Search produced empty results."))
 699         ;; Remember data for cache.
 700         (setq nnir-current-query group)
 701         (when server (setq nnir-current-server server))
 702         (setq nnir-current-group-marked gnus-group-marked)
 703         (nnheader-insert "211 %d %d %d %s\n"
 704                          (nnir-artlist-length nnir-artlist) ; total #
 705                          1              ; first #
 706                          (nnir-artlist-length nnir-artlist) ; last #
 707                          group)))))     ; group name
 708
 709 (deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
 710   (save-excursion
 711     (let ((artlist (copy-sequence articles))
 712           (idx 1)
 713           (art nil)
 714           (artitem nil)
 715           (artgroup nil) (artno nil)
 716           (artrsv nil)
 717           (artfullgroup nil)
 718           (novitem nil)
 719           (novdata nil)
 720           (foo nil))
 721       (while (not (null artlist))
 722         (setq art (car artlist))
 723         (or (numberp art)
 724             (nnheader-report
 725              'nnir
 726              "nnir-retrieve-headers doesn't grok message ids: %s"
 727              art))
 728         (setq artitem (nnir-artlist-article nnir-artlist art))
 729         (setq artrsv (nnir-artitem-rsv artitem))
 730         (setq artgroup (nnir-artitem-group artitem))
 731         (setq artno (nnir-artitem-number artitem))
 732         (setq artfullgroup (nnir-group-full-name artgroup))
 733         ;; retrieve NOV or HEAD data for this article, transform into
 734         ;; NOV data and prepend to `novdata'
 735         (set-buffer nntp-server-buffer)
 736         (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil))
 737           (nov
 738            (goto-char (point-min))
 739            (setq novitem (nnheader-parse-nov))
 740            (unless novitem
 741              (pop-to-buffer nntp-server-buffer)
 742              (error
 743               "nnheader-parse-nov returned nil for article %s in group %s"
 744               artno artfullgroup)))
 745           (headers
 746            (goto-char (point-min))
 747            (setq novitem (nnheader-parse-head))
 748            (unless novitem
 749              (pop-to-buffer nntp-server-buffer)
 750              (error
 751               "nnheader-parse-head returned nil for article %s in group %s"
 752               artno artfullgroup)))
 753           (t (nnheader-report 'nnir "Don't support header type %s." foo)))
 754         ;; replace article number in original group with article number
 755         ;; in nnir group
 756         (mail-header-set-number novitem idx)
 757         (mail-header-set-from novitem
 758                               (mail-header-from novitem))
 759         (mail-header-set-subject
 760          novitem
 761          (format "[%d: %s/%d] %s"
 762                  artrsv artgroup artno
 763                  (mail-header-subject novitem)))
 764         ;;-(mail-header-set-extra novitem nil)
 765         (push novitem novdata)
 766         (setq artlist (cdr artlist))
 767         (setq idx (1+ idx)))
 768       (setq novdata (nreverse novdata))
 769       (set-buffer nntp-server-buffer) (erase-buffer)
 770       (mapcar 'nnheader-insert-nov novdata)
 771       'nov)))
 772
 773 (deffoo nnir-request-article (article
 774                               &optional group server to-buffer)
 775   (save-excursion
 776     (let* ((artitem (nnir-artlist-article nnir-artlist
 777                                           article))
 778            (artgroup (nnir-artitem-group artitem))
 779            (artno (nnir-artitem-number artitem))
 780            ;; Bug?
 781            ;; Why must we bind nntp-server-buffer here?  It won't
 782            ;; work if `buf' is used, say.  (Of course, the set-buffer
 783            ;; line below must then be updated, too.)
 784            (nntp-server-buffer (or to-buffer nntp-server-buffer)))
 785       (set-buffer nntp-server-buffer)
 786       (erase-buffer)
 787       (message "Requesting article %d from group %s"
 788                artno
 789                (nnir-group-full-name artgroup))
 790       (gnus-request-article artno (nnir-group-full-name artgroup)
 791                             nntp-server-buffer)
 792       (cons artgroup artno))))
 793
 794
 795 (nnoo-define-skeleton nnir)
 796
 797 ;;; Search Engine Interfaces:
 798
 799 ;; Glimpse interface.
 800 (defun nnir-run-glimpse (query &optional group)
 801   "Run given query against glimpse.  Returns a vector of (group name, file name)
 802 pairs (also vectors, actually)."
 803   (save-excursion
 804     (let ((artlist nil)
 805           (groupspec (cdr (assq 'group query)))
 806           (qstring (cdr (assq 'query query))))
 807       (when (and group groupspec)
 808         (error (concat "It does not make sense to use a group spec"
 809                        " with process-marked groups.")))
 810       (when group
 811         (setq groupspec (gnus-group-real-name group)))
 812       (set-buffer (get-buffer-create nnir-tmp-buffer))
 813       (erase-buffer)
 814       (if groupspec
 815           (message "Doing glimpse query %s on %s..." query groupspec)
 816         (message "Doing glimpse query %s..." query))
 817       (let* ((cp-list
 818               `( ,nnir-glimpse-program
 819                  nil                    ; input from /dev/null
 820                  t                      ; output
 821                  nil                    ; don't redisplay
 822                  "-H" ,nnir-glimpse-home ; search home dir
 823                  "-W"                   ; match pattern in file
 824                  "-l" "-y"              ; misc options
 825                  ,@nnir-glimpse-additional-switches
 826                  "-F" ,nnir-glimpse-remove-prefix ; restrict output to mail
 827                  ,qstring               ; the query, in glimpse format
 828                 ))
 829              (exitstatus
 830               (progn
 831                 (message "%s args: %s" nnir-glimpse-program
 832                          (mapconcat 'identity (cddddr cp-list) " "))
 833                 (apply 'call-process cp-list))))
 834         (unless (or (null exitstatus)
 835                     (zerop exitstatus))
 836           (nnheader-report 'nnir "Couldn't run glimpse: %s" exitstatus)
 837           ;; Glimpse failure reason is in this buffer, show it if
 838           ;; the user wants it.
 839           (when (> gnus-verbose 6)
 840             (display-buffer nnir-tmp-buffer))))
 841       (when groupspec
 842         (keep-lines groupspec))
 843       (if groupspec
 844           (message "Doing glimpse query %s on %s...done" query groupspec)
 845         (message "Doing glimpse query %s...done" query))
 846       (sit-for 0)
 847       ;; CCC: The following work of extracting group name and article
 848       ;; number from the Glimpse output can probably better be done by
 849       ;; just going through the buffer once, and plucking out the
 850       ;; right information from each line.
 851       ;; remove superfluous stuff from glimpse output
 852       (goto-char (point-min))
 853       (delete-non-matching-lines "/[0-9]+$")
 854       ;;(delete-matching-lines "\\.overview~?$")
 855       (goto-char (point-min))
 856       (while (re-search-forward (concat "^" nnir-glimpse-remove-prefix) nil t)
 857         (replace-match ""))
 858       ;; separate group name from article number with \t
 859       ;; XEmacs compatible version
 860       (goto-char (point-max))
 861       (while (re-search-backward "/[0-9]+$" nil t)
 862         (delete-char 1 nil)
 863         (insert-char ?\t 1))
 864 ; Emacs compatible version
 865 ;      (goto-char (point-min))
 866 ;      (while (re-search-forward "\\(/\\)[0-9]+$" nil t)
 867 ;        (replace-match "\t" t t nil 1))
 868       ;; replace / with . in group names
 869       (subst-char-in-region (point-min) (point-max) ?/ ?. t)
 870       ;; massage buffer to contain some Lisp;
 871       ;; this depends on the artlist encoding internals
 872       ;; maybe this dependency should be removed?
 873       (goto-char (point-min))
 874       (while (not (eobp))
 875         (insert "[\"")
 876         (skip-chars-forward "^\t")
 877         (insert "\" ")
 878         (end-of-line)
 879         (insert " 1000 ]")              ; 1000 = score
 880         (forward-line 1))
 881       (insert "])\n")
 882       (goto-char (point-min))
 883       (insert "(setq artlist [\n")
 884       (eval-buffer)
 885       (sort* artlist
 886              (function (lambda (x y)
 887                          (if (string-lessp (nnir-artitem-group x)
 888                                            (nnir-artitem-group y))
 889                              t
 890                            (< (nnir-artitem-number x)
 891                               (nnir-artitem-number y))))))
 892       )))
 893
 894 ;; Namazu interface
 895 (defun nnir-run-namazu (query &optional group)
 896   "Run given query against namazu.  Returns a vector of (group name, file name)
 897 pairs (also vectors, actually)."
 898   (save-excursion
 899     (let ((artlist nil)
 900           (groupspec (cdr (assq 'group query)))
 901           (qstring (cdr (assq 'query query)))
 902           (coding-system-for-read 'euc-japan)
 903           (coding-system-for-write 'euc-japan))
 904       (when (and group groupspec)
 905         (error (concat "It does not make sense to use a group spec"
 906                        " with process-marked groups.")))
 907       (when group
 908         (setq groupspec (gnus-group-real-name group)))
 909       (set-buffer (get-buffer-create nnir-tmp-buffer))
 910       (erase-buffer)
 911       (if groupspec
 912           (message "Doing namazu query %s on %s..." query groupspec)
 913         (message "Doing namazu query %s..." query))
 914       (let* ((cp-list
 915               `( ,nnir-namazu-program
 916                  nil                    ; input from /dev/null
 917                  t                      ; output
 918                  nil                    ; don't redisplay
 919                  "--all" "--list" "--early"
 920                  ,(if groupspec
 921                       (format "+uri:%s %s" groupspec qstring)
 922                     (format "%s" qstring))
 923                  ,nnir-namazu-index     ; index
 924                 ))
 925              (exitstatus
 926               (progn
 927                 (message "%s args: %s" nnir-namazu-program
 928                          (mapconcat 'identity (cddddr cp-list) " "))
 929                 (apply 'call-process cp-list))))
 930         (unless (or (null exitstatus)
 931                     (zerop exitstatus))
 932           (nnheader-report "Couldn't run namazu: %s" exitstatus)
 933           ;; Namazu failure reason is in this buffer, show it if
 934           ;; the user wants it.
 935           (when (> gnus-verbose 6)
 936             (display-buffer nnir-tmp-buffer))))
 937       (if groupspec
 938           (message "Doing namazu query %s on %s..." query groupspec)
 939         (message "Doing namazu query %s...done" query))
 940       (sit-for 0)
 941       ;; CCC: The following work of extracting group name and article
 942       ;; number from the Namazu output can probably better be done by
 943       ;; just going through the buffer once, and plucking out the
 944       ;; right information from each line.
 945       ;; remove superfluous stuff from namazu output
 946       (goto-char (point-min))
 947       (delete-non-matching-lines "/[0-9]+$")
 948       ;;(delete-matching-lines "\\.overview~?$")
 949       (goto-char (point-min))
 950       (while (re-search-forward (concat "^" nnir-namazu-remove-prefix) nil t)
 951         (replace-match ""))
 952       ;; separate group name from article number with \t
 953       ;; XEmacs compatible version
 954       (goto-char (point-max))
 955       (while (re-search-backward "/[0-9]+$" nil t)
 956         (delete-char 1 nil)
 957         (insert-char ?\t 1))
 958 ; Emacs compatible version
 959 ;      (goto-char (point-min))
 960 ;      (while (re-search-forward "\\(/\\)[0-9]+$" nil t)
 961 ;        (replace-match "\t" t t nil 1))
 962       ;; replace / with . in group names
 963       (subst-char-in-region (point-min) (point-max) ?/ ?. t)
 964       ;; massage buffer to contain some Lisp;
 965       ;; this depends on the artlist encoding internals
 966       ;; maybe this dependency should be removed?
 967       (goto-char (point-min))
 968       (while (not (eobp))
 969         (insert "(\"")
 970         (skip-chars-forward "^\t")
 971         (insert "\" ")
 972         (end-of-line)
 973         (insert " 1000 )")              ; 1000 = score
 974         (forward-line 1))
 975       (insert "))\n")
 976       (goto-char (point-min))
 977       (insert "(setq artlist '(\n")
 978       (eval-buffer)
 979       artlist
 980       )))
 981
 982 ;; freeWAIS-sf interface.
 983 (defun nnir-run-waissearch (query &optional group)
 984   "Run given query agains waissearch.  Returns vector of (group name, file name)
 985 pairs (also vectors, actually)."
 986   (when group
 987     (error "The freeWAIS-sf backend cannot search specific groups."))
 988   (save-excursion
 989     (let ((qstring (cdr (assq 'query query)))
 990           (artlist nil)
 991           (score nil) (artno nil) (dirnam nil) (group nil))
 992       (set-buffer (get-buffer-create nnir-tmp-buffer))
 993       (erase-buffer)
 994       (message "Doing WAIS query %s..." query)
 995       (call-process nnir-wais-program
 996                     nil                 ; input from /dev/null
 997                     t                   ; output to current buffer
 998                     nil                 ; don't redisplay
 999                     "-d" nnir-wais-database ; database to search
1000                     qstring)
1001       (message "Massaging waissearch output...")
1002       ;; remove superfluous lines
1003       (keep-lines "Score:")
1004       ;; extract data from result lines
1005       (goto-char (point-min))
1006       (while (re-search-forward
1007               "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t)
1008         (setq score (match-string 1)
1009               artno (match-string 2)
1010               dirnam (match-string 3))
1011         (unless (string-match nnir-wais-remove-prefix dirnam)
1012           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
1013                            dirnam nnir-wais-remove-prefix))
1014         (setq group (substitute ?. ?/ (replace-match "" t t dirnam)))
1015         (push (vector group
1016                       (string-to-int artno)
1017                       (string-to-int score))
1018               artlist))
1019       (message "Massaging waissearch output...done")
1020       (apply 'vector
1021              (sort* artlist
1022                     (function (lambda (x y)
1023                                 (> (nnir-artitem-rsv x)
1024                                    (nnir-artitem-rsv y)))))))))
1025
1026 ;; EWS (Excite for Web Servers) interface
1027 (defun nnir-run-excite-search (query &optional group)
1028   "Run a given query against EWS.  Returns vector of (group name, file name)
1029 pairs (also vectors, actually)."
1030   (when group
1031     (error "Searching specific groups not implemented for EWS."))
1032   (save-excursion
1033     (let ((qstring (cdr (assq 'query query)))
1034           artlist group article-num article)
1035       (setq nnir-current-query query)
1036       (set-buffer (get-buffer-create nnir-tmp-buffer))
1037       (erase-buffer)
1038       (message "Doing EWS query %s..." qstring)
1039       (call-process nnir-excite-aquery-program
1040                     nil                 ; input from /dev/null
1041                     t                   ; output to current buffer
1042                     nil                 ; don't redisplay
1043                     nnir-excite-collection
1044                     (if (string= (substring qstring 0 1) "(")
1045                         qstring
1046                       (format "(concept %s)" qstring)))
1047       (message "Gathering query output...")
1048
1049       (goto-char (point-min))
1050       (while (re-search-forward
1051               "^[0-9]+\\s-[0-9]+\\s-[0-9]+\\s-\\(\\S-*\\)" nil t)
1052         (setq article (match-string 1))
1053         (unless (string-match
1054                  (concat "^" (regexp-quote nnir-excite-remove-prefix)
1055                          "\\(.*\\)/\\([0-9]+\\)") article)
1056           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
1057                            article nnir-excite-remove-prefix))
1058         (setq group (substitute ?. ?/ (match-string 1 article)))
1059         (setq article-num (match-string 2 article))
1060         (setq artlist (vconcat artlist (vector (vector group
1061                                                        (string-to-int article-num)
1062                                                        1000)))))
1063       (message "Gathering query output...done")
1064       artlist)))
1065
1066 ;; IMAP interface.  The following function is Copyright (C) 1998 Simon
1067 ;; Josefsson <jas@pdc.kth.se>.
1068 ;; todo:
1069 ;; nnir invokes this two (2) times???!
1070 ;; we should not use nnimap at all but open our own server connection
1071 ;; we should not LIST * but use nnimap-list-pattern from defs
1072 ;; send queries as literals
1073 ;; handle errors
1074
1075 (defun nnir-run-imap (query &optional group)
1076   (require 'imap)
1077   (require 'nnimap)
1078   (unless group
1079     (error "Must specify groups for IMAP searching."))
1080   (save-excursion
1081     (let ((qstring (cdr (assq 'query query)))
1082           (server (cadr nnir-mail-backend))
1083           (defs (caddr nnir-mail-backend))
1084           artlist buf)
1085       (message "Opening server %s" server)
1086       (condition-case ()
1087           (when (nnimap-open-server server defs) ;; xxx
1088             (setq buf nnimap-server-buffer) ;; xxx
1089             (message "Searching %s..." group)
1090             (let ((arts 0)
1091                   (mbx (gnus-group-real-name group)))
1092               (when (imap-mailbox-select mbx nil buf)
1093                 (mapcar
1094                  (lambda (artnum)
1095                    (push (vector mbx artnum 1) artlist)
1096                    (setq arts (1+ arts)))
1097                  (imap-search (concat "TEXT \"" qstring "\"") buf))
1098                 (message "Searching %s... %d matches" mbx arts)))
1099             (message "Searching %s...done" group))
1100         (quit nil))
1101       (reverse artlist))))
1102
1103 ;; Swish++ interface.  The following function is Copyright (C) 2000,
1104 ;; 2001 Christoph Conrad <christoph.conrad@gmx.de>.
1105 ;; -cc- Todo
1106 ;; Search by
1107 ;; - group
1108 ;; Sort by
1109 ;; - rank (default)
1110 ;; - article number
1111 ;; - file size
1112 ;; - group
1113 (defun nnir-run-swish++ (query &optional group)
1114   "Run given query against swish++.
1115 Returns a vector of (group name, file name) pairs (also vectors,
1116 actually).
1117
1118 Tested with swish++ 4.7 on GNU/Linux and with with swish++ 5.0b2 on
1119 Windows NT 4.0."
1120
1121   (when group
1122     (error "The swish++ backend cannot search specific groups."))
1123
1124   (save-excursion
1125     (let ( (qstring (cdr (assq 'query query)))
1126            (groupspec (cdr (assq 'group query)))
1127            (artlist nil)
1128            (score nil) (artno nil) (dirnam nil) (group nil) )
1129
1130       (when (equal "" qstring)
1131         (error "swish++: You didn't enter anything."))
1132
1133       (set-buffer (get-buffer-create nnir-tmp-buffer))
1134       (erase-buffer)
1135
1136       (if groupspec
1137           (message "Doing swish++ query %s on %s..." qstring groupspec)
1138         (message "Doing swish++ query %s..." qstring))
1139
1140       (let* ((cp-list `( ,nnir-swish++-program
1141                          nil            ; input from /dev/null
1142                          t              ; output
1143                          nil            ; don't redisplay
1144                          "--config-file" ,nnir-swish++-configuration-file
1145                          ,@nnir-swish++-additional-switches
1146                          ,qstring       ; the query, in swish++ format
1147                          ))
1148              (exitstatus
1149               (progn
1150                 (message "%s args: %s" nnir-swish++-program
1151                          (mapconcat 'identity (cddddr cp-list) " "));; ???
1152                 (apply 'call-process cp-list))))
1153         (unless (or (null exitstatus)
1154                     (zerop exitstatus))
1155           (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus)
1156           ;; swish++ failure reason is in this buffer, show it if
1157           ;; the user wants it.
1158           (when (> gnus-verbose 6)
1159             (display-buffer nnir-tmp-buffer))))
1160
1161       ;; The results are output in the format of:
1162       ;; V 4.7 Linux
1163       ;; rank relative-path-name file-size file-title
1164       ;; V 5.0b2:
1165       ;; rank relative-path-name file-size topic??
1166       ;; where rank is an integer from 1 to 100.
1167       (goto-char (point-min))
1168       (while (re-search-forward
1169               "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
1170         (setq score (match-string 1)
1171               artno (file-name-nondirectory (match-string 2))
1172               dirnam (file-name-directory (match-string 2)))
1173
1174         ;; don't match directories
1175         (when (string-match "^[0-9]+$" artno)
1176           (when (not (null dirnam))
1177
1178             ; maybe limit results to matching groups.
1179             (when (or (not groupspec)
1180                       (string-match groupspec dirnam))
1181
1182               ;; remove nnir-swish++-remove-prefix from beginning of dirname
1183               (when (string-match (concat "^" nnir-swish++-remove-prefix)
1184                                   dirnam)
1185                 (setq dirnam (replace-match "" t t dirnam)))
1186
1187               (setq dirnam (substring dirnam 0 -1))
1188               ;; eliminate all ".", "/", "\" from beginning. Always matches.
1189               (string-match "^[./\\]*\\(.*\\)$" dirnam)
1190               ;; "/" -> "."
1191               (setq group (substitute ?. ?/ (match-string 1 dirnam)))
1192               ;; "\\" -> "."
1193               (setq group (substitute ?. ?\\ group))
1194
1195               (push (vector group
1196                             (string-to-int artno)
1197                             (string-to-int score))
1198                     artlist)))))
1199
1200       (message "Massaging swish++ output...done")
1201
1202       ;; Sort by score
1203       (apply 'vector
1204              (sort* artlist
1205                     (function (lambda (x y)
1206                                 (> (nnir-artitem-rsv x)
1207                                    (nnir-artitem-rsv y)))))))))
1208
1209 ;; Swish-E interface.  The following function is Copyright (C) 2000,
1210 ;; 2001 by Christoph Conrad <christoph.conrad@gmx.de>.
1211 (defun nnir-run-swish-e (query &optional group)
1212   "Run given query against swish-e.
1213 Returns a vector of (group name, file name) pairs (also vectors,
1214 actually).
1215
1216 Tested with swish-e-2.0.1 on Windows NT 4.0."
1217
1218   ;; swish-e crashes with empty parameter to "-w" on commandline...
1219   (when group
1220     (error "The swish-e backend cannot search specific groups."))
1221
1222   (save-excursion
1223     (let ( (qstring (cdr (assq 'query query)))
1224            (artlist nil)
1225            (score nil) (artno nil) (dirnam nil) (group nil) )
1226
1227       (when (equal "" qstring)
1228         (error "swish-e: You didn't enter anything."))
1229
1230       (set-buffer (get-buffer-create nnir-tmp-buffer))
1231       (erase-buffer)
1232
1233       (message "Doing swish-e query %s..." query)
1234       (let* ((cp-list `( ,nnir-swish-e-program
1235                          nil            ; input from /dev/null
1236                          t              ; output
1237                          nil            ; don't redisplay
1238                          "-f" ,nnir-swish-e-index-file
1239                          ,@nnir-swish-e-additional-switches
1240                          "-w"
1241                          ,qstring       ; the query, in swish-e format
1242                          ))
1243              (exitstatus
1244               (progn
1245                 (message "%s args: %s" nnir-swish-e-program
1246                          (mapconcat 'identity (cddddr cp-list) " "))
1247                 (apply 'call-process cp-list))))
1248         (unless (or (null exitstatus)
1249                     (zerop exitstatus))
1250           (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus)
1251           ;; swish-e failure reason is in this buffer, show it if
1252           ;; the user wants it.
1253           (when (> gnus-verbose 6)
1254             (display-buffer nnir-tmp-buffer))))
1255
1256       ;; The results are output in the format of:
1257       ;; rank path-name file-title file-size
1258       (goto-char (point-min))
1259       (while (re-search-forward
1260               "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
1261         (setq score (match-string 1)
1262               artno (match-string 3)
1263               dirnam (file-name-directory (match-string 2)))
1264
1265         ;; don't match directories
1266         (when (string-match "^[0-9]+$" artno)
1267           (when (not (null dirnam))
1268
1269             ;; remove nnir-swish-e-remove-prefix from beginning of dirname
1270             (when (string-match (concat "^" nnir-swish-e-remove-prefix)
1271                                 dirnam)
1272               (setq dirnam (replace-match "" t t dirnam)))
1273
1274             (setq dirnam (substring dirnam 0 -1))
1275             ;; eliminate all ".", "/", "\" from beginning. Always matches.
1276             (string-match "^[./\\]*\\(.*\\)$" dirnam)
1277             ;; "/" -> "."
1278             (setq group (substitute ?. ?/ (match-string 1 dirnam)))
1279             ;; Windows "\\" -> "."
1280             (setq group (substitute ?. ?\\ group))
1281
1282             (push (vector group
1283                           (string-to-int artno)
1284                           (string-to-int score))
1285                   artlist))))
1286
1287       (message "Massaging swish-e output...done")
1288
1289       ;; Sort by score
1290       (apply 'vector
1291              (sort* artlist
1292                     (function (lambda (x y)
1293                                 (> (nnir-artitem-rsv x)
1294                                    (nnir-artitem-rsv y)))))))))
1295
1296 ;; Namazu interface
1297 (defun nnir-run-namazu (query &optional group)
1298   "Run given query against Namazu.  Returns a vector of (group name, file name)
1299 pairs (also vectors, actually).
1300
1301 Tested with Namazu 2.0.6 on a GNU/Linux system."
1302   (when group
1303     (error "The Namazu backend cannot search specific groups"))
1304   (save-excursion
1305     (let (
1306           (artlist nil)
1307           (qstring (cdr (assq 'query query)))
1308           (score nil)
1309           (group nil)
1310           (article nil)
1311           )
1312       (set-buffer (get-buffer-create nnir-tmp-buffer))
1313       (erase-buffer)
1314       (let* ((cp-list
1315               `( ,nnir-namazu-program
1316                  nil              ; input from /dev/null
1317                  t                ; output
1318                  nil              ; don't redisplay
1319                  "-q"             ; don't be verbose
1320                  "-a"             ; show all matches
1321                  "-s"             ; use short format
1322                  ,@nnir-namazu-additional-switches
1323                  ,qstring         ; the query, in namazu format
1324                  ,nnir-namazu-index-directory ; index directory
1325                  ))
1326              (exitstatus
1327               (progn
1328                 (message "%s args: %s" nnir-namazu-program
1329                          (mapconcat 'identity (cddddr cp-list) " "))
1330                 (apply 'call-process cp-list))))
1331         (unless (or (null exitstatus)
1332                     (zerop exitstatus))
1333           (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus)
1334           ;; Namazu failure reason is in this buffer, show it if
1335           ;; the user wants it.
1336           (when (> gnus-verbose 6)
1337             (display-buffer nnir-tmp-buffer))))
1338
1339       ;; Namazu output looks something like this:
1340       ;; 2. Re: Gnus agent expire broken (score: 55)
1341       ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes)
1342
1343       (goto-char (point-min))
1344       (while (re-search-forward
1345               "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
1346               nil t)
1347         (setq score (match-string 3)
1348               group (file-name-directory (match-string 4))
1349               article (file-name-nondirectory (match-string 4)))
1350
1351         ;; make sure article and group is sane
1352         (when (and (string-match "^[0-9]+$" article)
1353                    (not (null group)))
1354           (when (string-match (concat "^" nnir-namazu-remove-prefix) group)
1355             (setq group (replace-match "" t t group)))
1356
1357           ;; remove trailing slash from groupname
1358           (setq group (substring group 0 -1))
1359
1360           ;; stuff results into artlist vector
1361           (push (vector (substitute ?. ?/ group)
1362                         (string-to-int article)
1363                         (string-to-int score)) artlist)))
1364
1365       ;; sort artlist by score
1366       (apply 'vector
1367              (sort* artlist
1368                     (function (lambda (x y)
1369                                 (> (nnir-artitem-rsv x)
1370                                    (nnir-artitem-rsv y)))))))))
1371
1372 ;;; Util Code:
1373
1374 (defun nnir-read-parms (query)
1375   "Reads additional search parameters according to `nnir-engines'."
1376   (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
1377     (cons (cons 'query query)
1378           (mapcar 'nnir-read-parm parmspec))))
1379
1380 (defun nnir-read-parm (parmspec)
1381   "Reads a single search parameter.
1382 `parmspec' is a cons cell, the car is a symbol, the cdr is a prompt."
1383   (let ((sym (car parmspec))
1384         (prompt (cdr parmspec)))
1385     (cons sym (read-string prompt))))
1386
1387 (defun nnir-run-query (query)
1388   "Invoke appropriate search engine function (see `nnir-engines').
1389 If some groups were process-marked, run the query for each of the groups
1390 and concat the results."
1391   (let ((search-func (cadr (assoc nnir-search-engine nnir-engines)))
1392         (q (car (read-from-string query))))
1393     (if gnus-group-marked
1394         (apply 'append
1395                (mapcar (lambda (x)
1396                          (funcall search-func q x))
1397                        gnus-group-marked))
1398       (funcall search-func q nil))))
1399
1400 (defun nnir-group-full-name (shortname)
1401   "For the given group name, return a full Gnus group name.
1402 The Gnus backend/server information is added."
1403   (gnus-group-prefixed-name shortname nnir-mail-backend))
1404
1405 (defun nnir-possibly-change-server (server)
1406   (unless (and server (nnir-server-opened server))
1407     (nnir-open-server server)))
1408
1409
1410 ;; Data type article list.
1411
1412 (defun nnir-artlist-length (artlist)
1413   "Returns number of articles in artlist."
1414   (length artlist))
1415
1416 (defun nnir-artlist-article (artlist n)
1417   "Returns from ARTLIST the Nth artitem (counting starting at 1)."
1418   (elt artlist (1- n)))
1419
1420 (defun nnir-artitem-group (artitem)
1421   "Returns the group from the ARTITEM."
1422   (elt artitem 0))
1423
1424 (defun nnir-artlist-artitem-group (artlist n)
1425   "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
1426   (nnir-artitem-group (nnir-artlist-article artlist n)))
1427
1428 (defun nnir-artitem-number (artitem)
1429   "Returns the number from the ARTITEM."
1430   (elt artitem 1))
1431
1432 (defun nnir-artlist-artitem-number (artlist n)
1433   "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
1434   (nnir-artitem-number (nnir-artlist-article artlist n)))
1435
1436 (defun nnir-artitem-rsv (artitem)
1437   "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
1438   (elt artitem 2))
1439
1440 (defun nnir-artlist-artitem-rsv (artlist n)
1441   "Returns from ARTLIST the Retrieval Status Value of the Nth artitem
1442 (counting from 1)."
1443   (nnir-artitem-rsv (nnir-artlist-article artlist n)))
1444
1445 ;; unused?
1446 (defun nnir-artlist-groups (artlist)
1447   "Returns a list of all groups in the given ARTLIST."
1448   (let ((res nil)
1449         (with-dups nil))
1450     ;; from each artitem, extract group component
1451     (setq with-dups (mapcar 'nnir-artitem-group artlist))
1452     ;; remove duplicates from above
1453     (mapcar (function (lambda (x) (add-to-list 'res x)))
1454             with-dups)
1455     res))
1456
1457
1458 ;; The end.
1459 (provide 'nnir)