diff options
| author | Miles Bader | 2008-06-06 22:53:14 +0000 |
|---|---|---|
| committer | Miles Bader | 2008-06-06 22:53:14 +0000 |
| commit | e6d2d263da3c83033860f408bc400386b54ff288 (patch) | |
| tree | c4c0f27e446dee40040fa777ee9735285d85aeda /lisp | |
| parent | 2a6c4d7524018fcf0fe9fa9657c67a9376a8a5dc (diff) | |
| download | emacs-e6d2d263da3c83033860f408bc400386b54ff288.tar.gz emacs-e6d2d263da3c83033860f408bc400386b54ff288.zip | |
Merge from gnus--devo--0
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-1215
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/Makefile.in | 1 | ||||
| -rw-r--r-- | lisp/gnus/ChangeLog | 4 | ||||
| -rw-r--r-- | lisp/gnus/nnir.el | 1666 |
4 files changed, 1675 insertions, 0 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3a911766d51..a5174018a68 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2008-06-06 Miles Bader <miles@gnu.org> | ||
| 2 | |||
| 3 | * Makefile.in (ELCFILES): Add gnus/nndir.elc. | ||
| 4 | |||
| 1 | 2008-06-06 Chong Yidong <cyd@stupidchicken.com> | 5 | 2008-06-06 Chong Yidong <cyd@stupidchicken.com> |
| 2 | 6 | ||
| 3 | * menu-bar.el (menu-bar-options-menu): Add Menu entry for | 7 | * menu-bar.el (menu-bar-options-menu): Add Menu entry for |
diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 2d9fe09d711..78ca42b4993 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in | |||
| @@ -600,6 +600,7 @@ ELCFILES = \ | |||
| 600 | $(lisp)/gnus/nngateway.elc \ | 600 | $(lisp)/gnus/nngateway.elc \ |
| 601 | $(lisp)/gnus/nnheader.elc \ | 601 | $(lisp)/gnus/nnheader.elc \ |
| 602 | $(lisp)/gnus/nnimap.elc \ | 602 | $(lisp)/gnus/nnimap.elc \ |
| 603 | $(lisp)/gnus/nnir.elc \ | ||
| 603 | $(lisp)/gnus/nnkiboze.elc \ | 604 | $(lisp)/gnus/nnkiboze.elc \ |
| 604 | $(lisp)/gnus/nnlistserv.elc \ | 605 | $(lisp)/gnus/nnlistserv.elc \ |
| 605 | $(lisp)/gnus/nnmail.elc \ | 606 | $(lisp)/gnus/nnmail.elc \ |
diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 7f678b91b9e..8b37e7e99a4 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog | |||
| @@ -1,3 +1,7 @@ | |||
| 1 | 2008-06-05 Reiner Steib <Reiner.Steib@gmx.de> | ||
| 2 | |||
| 3 | * nnir.el: New file. | ||
| 4 | |||
| 1 | 2008-06-05 Stefan Monnier <monnier@iro.umontreal.ca> | 5 | 2008-06-05 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 6 | ||
| 3 | * gnus-util.el (gnus-read-shell-command): New function. | 7 | * gnus-util.el (gnus-read-shell-command): New function. |
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el new file mode 100644 index 00000000000..df83f18c83c --- /dev/null +++ b/lisp/gnus/nnir.el | |||
| @@ -0,0 +1,1666 @@ | |||
| 1 | ;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, | ||
| 4 | ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. | ||
| 5 | |||
| 6 | ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de> | ||
| 7 | ;; Swish-e and Swish++ backends by: | ||
| 8 | ;; Christoph Conrad <christoph.conrad@gmx.de>. | ||
| 9 | ;; IMAP backend by: Simon Josefsson <jas@pdc.kth.se>. | ||
| 10 | ;; IMAP search by: Torsten Hilbrich <torsten.hilbrich <at> gmx.net> | ||
| 11 | ;; IMAP search improved by Daniel Pittman <daniel@rimspace.net>. | ||
| 12 | ;; nnmaildir support for Swish++ and Namazu backends by: | ||
| 13 | ;; Justus Piater <Justus <at> Piater.name> | ||
| 14 | |||
| 15 | ;; TODO: Documentation in the Gnus manual | ||
| 16 | |||
| 17 | ;; From: Reiner Steib | ||
| 18 | ;; Subject: Re: Including nnir.el | ||
| 19 | ;; Newsgroups: gmane.emacs.gnus.general | ||
| 20 | ;; Message-ID: <v9d5dnp6aq.fsf@marauder.physik.uni-ulm.de> | ||
| 21 | ;; Date: 2006-06-05 22:49:01 GMT | ||
| 22 | ;; | ||
| 23 | ;; On Sun, Jun 04 2006, Sascha Wilde wrote: | ||
| 24 | ;; | ||
| 25 | ;; > The one thing most hackers like to forget: Documentation. By now the | ||
| 26 | ;; > documentation is only in the comments at the head of the source, I | ||
| 27 | ;; > would use it as basis to cook up some minimal texinfo docs. | ||
| 28 | ;; > | ||
| 29 | ;; > Where in the existing gnus manual would this fit best? | ||
| 30 | |||
| 31 | ;; Maybe (info "(gnus)Combined Groups") for a general description. | ||
| 32 | ;; `gnus-group-make-nnir-group' might be described in (info | ||
| 33 | ;; "(gnus)Foreign Groups") as well. | ||
| 34 | |||
| 35 | ;; Keywords: news mail searching ir | ||
| 36 | |||
| 37 | ;; This file is part of GNU Emacs. | ||
| 38 | |||
| 39 | ;; This is free software; you can redistribute it and/or modify | ||
| 40 | ;; it under the terms of the GNU General Public License as published by | ||
| 41 | ;; the Free Software Foundation; either version 3, or (at your option) | ||
| 42 | ;; any later version. | ||
| 43 | |||
| 44 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 45 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 46 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 47 | ;; GNU General Public License for more details. | ||
| 48 | |||
| 49 | ;; You should have received a copy of the GNU General Public License | ||
| 50 | ;; along with GNU Emacs; see the file COPYING. If not, write to the | ||
| 51 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, | ||
| 52 | ;; Boston, MA 02110-1301, USA. | ||
| 53 | |||
| 54 | ;;; Commentary: | ||
| 55 | |||
| 56 | ;; The most recent version of this can always be fetched from the Gnus | ||
| 57 | ;; CVS repository. See http://www.gnus.org/ for more information. | ||
| 58 | |||
| 59 | ;; This code is still in the development stage but I'd like other | ||
| 60 | ;; people to have a look at it. Please do not hesitate to contact me | ||
| 61 | ;; with your ideas. | ||
| 62 | |||
| 63 | ;; What does it do? Well, it allows you to index your mail using some | ||
| 64 | ;; search engine (freeWAIS-sf, swish-e and others -- see later), | ||
| 65 | ;; then type `G G' in the Group buffer and issue a query to the search | ||
| 66 | ;; engine. You will then get a buffer which shows all articles | ||
| 67 | ;; matching the query, sorted by Retrieval Status Value (score). | ||
| 68 | |||
| 69 | ;; When looking at the retrieval result (in the Summary buffer) you | ||
| 70 | ;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an | ||
| 71 | ;; article. You will be teleported into the group this article came | ||
| 72 | ;; from, showing the thread this article is part of. (See below for | ||
| 73 | ;; restrictions.) | ||
| 74 | |||
| 75 | ;; The Lisp installation is simple: just put this file on your | ||
| 76 | ;; load-path, byte-compile it, and load it from ~/.gnus or something. | ||
| 77 | ;; This will install a new command `G G' in your Group buffer for | ||
| 78 | ;; searching your mail. Note that you also need to configure a number | ||
| 79 | ;; of variables, as described below. | ||
| 80 | |||
| 81 | ;; Restrictions: | ||
| 82 | ;; | ||
| 83 | ;; * If you don't use HyREX as your search engine, this expects that | ||
| 84 | ;; you use nnml or another one-file-per-message backend, because the | ||
| 85 | ;; others doesn't support nnfolder. | ||
| 86 | ;; * It can only search the mail backend's which are supported by one | ||
| 87 | ;; search engine, because of different query languages. | ||
| 88 | ;; * There are restrictions to the Wais setup. | ||
| 89 | ;; * There are restrictions to the imap setup. | ||
| 90 | ;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before | ||
| 91 | ;; limiting to the right articles. This is much too slow, of | ||
| 92 | ;; course. May issue a query for number of articles to fetch; you | ||
| 93 | ;; must accept the default of all articles at this point or things | ||
| 94 | ;; may break. | ||
| 95 | |||
| 96 | ;; The Lisp setup involves setting a few variables and setting up the | ||
| 97 | ;; search engine. You can define the variables in the server definition | ||
| 98 | ;; like this : | ||
| 99 | ;; (setq gnus-secondary-select-methods '( | ||
| 100 | ;; (nnimap "" (nnimap-address "localhost") | ||
| 101 | ;; (nnir-search-engine hyrex) | ||
| 102 | ;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml")) | ||
| 103 | ;; ))) | ||
| 104 | ;; Or you can define the global ones. The variables set in the mailer- | ||
| 105 | ;; definition will be used first. | ||
| 106 | ;; The variable to set is `nnir-search-engine'. Choose one of the engines | ||
| 107 | ;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist, | ||
| 108 | ;; type `C-h v nnir-engines RET' for more information; this includes | ||
| 109 | ;; examples for setting `nnir-search-engine', too.) | ||
| 110 | ;; | ||
| 111 | ;; The variable nnir-mail-backend isn't used anymore. | ||
| 112 | ;; | ||
| 113 | |||
| 114 | ;; You must also set up a search engine. I'll tell you about the two | ||
| 115 | ;; search engines currently supported: | ||
| 116 | |||
| 117 | ;; 1. freeWAIS-sf | ||
| 118 | ;; | ||
| 119 | ;; As always with freeWAIS-sf, you need a so-called `format file'. I | ||
| 120 | ;; use the following file: | ||
| 121 | ;; | ||
| 122 | ;; ,----- | ||
| 123 | ;; | # Kai's format file for freeWAIS-sf for indexing mails. | ||
| 124 | ;; | # Each mail is in a file, much like the MH format. | ||
| 125 | ;; | | ||
| 126 | ;; | # Document separator should never match -- each file is a document. | ||
| 127 | ;; | record-sep: /^@this regex should never match@$/ | ||
| 128 | ;; | | ||
| 129 | ;; | # Searchable fields specification. | ||
| 130 | ;; | | ||
| 131 | ;; | region: /^[sS]ubject:/ /^[sS]ubject: */ | ||
| 132 | ;; | subject "Subject header" stemming TEXT BOTH | ||
| 133 | ;; | end: /^[^ \t]/ | ||
| 134 | ;; | | ||
| 135 | ;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */ | ||
| 136 | ;; | to "To and Cc headers" SOUNDEX BOTH | ||
| 137 | ;; | end: /^[^ \t]/ | ||
| 138 | ;; | | ||
| 139 | ;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */ | ||
| 140 | ;; | from "From header" SOUNDEX BOTH | ||
| 141 | ;; | end: /^[^ \t]/ | ||
| 142 | ;; | | ||
| 143 | ;; | region: /^$/ | ||
| 144 | ;; | stemming TEXT GLOBAL | ||
| 145 | ;; | end: /^@this regex should never match@$/ | ||
| 146 | ;; `----- | ||
| 147 | ;; | ||
| 148 | ;; 1998-07-22: waisindex would dump core on me for large articles with | ||
| 149 | ;; the above settings. I used /^$/ as the end regex for the global | ||
| 150 | ;; field. That seemed to work okay. | ||
| 151 | |||
| 152 | ;; There is a Perl module called `WAIS.pm' which is available from | ||
| 153 | ;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This | ||
| 154 | ;; module comes with a nifty tool called `makedb', which I use for | ||
| 155 | ;; indexing. Here's my `makedb.conf': | ||
| 156 | ;; | ||
| 157 | ;; ,----- | ||
| 158 | ;; | # Config file for makedb | ||
| 159 | ;; | | ||
| 160 | ;; | # Global options | ||
| 161 | ;; | waisindex = /usr/local/bin/waisindex | ||
| 162 | ;; | wais_opt = -stem -t fields | ||
| 163 | ;; | # `-stem' option necessary when `stemming' is specified for the | ||
| 164 | ;; | # global field in the *.fmt file | ||
| 165 | ;; | | ||
| 166 | ;; | # Own variables | ||
| 167 | ;; | homedir = /home/kai | ||
| 168 | ;; | | ||
| 169 | ;; | # The mail database. | ||
| 170 | ;; | database = mail | ||
| 171 | ;; | files = `find $homedir/Mail -name \*[0-9] -print` | ||
| 172 | ;; | dbdir = $homedir/.wais | ||
| 173 | ;; | limit = 100 | ||
| 174 | ;; `----- | ||
| 175 | ;; | ||
| 176 | ;; The Lisp setup involves the `nnir-wais-*' variables. The most | ||
| 177 | ;; difficult to understand variable is probably | ||
| 178 | ;; `nnir-wais-remove-prefix'. Here's what it does: the output of | ||
| 179 | ;; `waissearch' basically contains the file name and the (full) | ||
| 180 | ;; directory name. As Gnus works with group names rather than | ||
| 181 | ;; directory names, the directory name is transformed into a group | ||
| 182 | ;; name as follows: first, a prefix is removed from the (full) | ||
| 183 | ;; directory name, then all `/' are replaced with `.'. The variable | ||
| 184 | ;; `nnir-wais-remove-prefix' should contain a regex matching exactly | ||
| 185 | ;; this prefix. It defaults to `$HOME/Mail/' (note the trailing | ||
| 186 | ;; slash). | ||
| 187 | |||
| 188 | ;; 2. Namazu | ||
| 189 | ;; | ||
| 190 | ;; The Namazu backend requires you to have one directory containing all | ||
| 191 | ;; index files, this is controlled by the `nnir-namazu-index-directory' | ||
| 192 | ;; variable. To function the `nnir-namazu-remove-prefix' variable must | ||
| 193 | ;; also be correct, see the documentation for `nnir-wais-remove-prefix' | ||
| 194 | ;; above. | ||
| 195 | ;; | ||
| 196 | ;; It is particularly important not to pass any any switches to namazu | ||
| 197 | ;; that will change the output format. Good switches to use include | ||
| 198 | ;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu | ||
| 199 | ;; documentation for further information on valid switches. | ||
| 200 | ;; | ||
| 201 | ;; To index my mail with the `mknmz' program I use the following | ||
| 202 | ;; configuration file: | ||
| 203 | ;; | ||
| 204 | ;; ,---- | ||
| 205 | ;; | package conf; # Don't remove this line! | ||
| 206 | ;; | | ||
| 207 | ;; | # Paths which will not be indexed. Don't use `^' or `$' anchors. | ||
| 208 | ;; | $EXCLUDE_PATH = "spam|sent"; | ||
| 209 | ;; | | ||
| 210 | ;; | # Header fields which should be searchable. case-insensitive | ||
| 211 | ;; | $REMAIN_HEADER = "from|date|message-id|subject"; | ||
| 212 | ;; | | ||
| 213 | ;; | # Searchable fields. case-insensitive | ||
| 214 | ;; | $SEARCH_FIELD = "from|date|message-id|subject"; | ||
| 215 | ;; | | ||
| 216 | ;; | # The max length of a word. | ||
| 217 | ;; | $WORD_LENG_MAX = 128; | ||
| 218 | ;; | | ||
| 219 | ;; | # The max length of a field. | ||
| 220 | ;; | $MAX_FIELD_LENGTH = 256; | ||
| 221 | ;; `---- | ||
| 222 | ;; | ||
| 223 | ;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and | ||
| 224 | ;; ~/Mail/archive/, so to index them I go to the directory set in | ||
| 225 | ;; `nnir-namazu-index-directory' and issue the following command. | ||
| 226 | ;; | ||
| 227 | ;; mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/ | ||
| 228 | ;; | ||
| 229 | ;; For maximum searching efficiency I have a cron job set to run this | ||
| 230 | ;; command every four hours. | ||
| 231 | |||
| 232 | ;; 3. HyREX | ||
| 233 | ;; | ||
| 234 | ;; The HyREX backend requires you to have one directory from where all | ||
| 235 | ;; your relative paths are to, if you use them. This directory must be | ||
| 236 | ;; set in the `nnir-hyrex-index-directory' variable, which defaults to | ||
| 237 | ;; your home directory. You must also pass the base, class and | ||
| 238 | ;; directory options or simply your dll to the `nnir-hyrex-programm' by | ||
| 239 | ;; setting the `nnir-hyrex-additional-switches' variable accordently. | ||
| 240 | ;; To function the `nnir-hyrex-remove-prefix' variable must also be | ||
| 241 | ;; correct, see the documentation for `nnir-wais-remove-prefix' above. | ||
| 242 | |||
| 243 | ;; 4. find-grep | ||
| 244 | ;; | ||
| 245 | ;; The find-grep engine simply runs find(1) to locate eligible | ||
| 246 | ;; articles and searches them with grep(1). This, of course, is much | ||
| 247 | ;; slower than using a proper search engine but OTOH doesn't require | ||
| 248 | ;; maintenance of an index and is still faster than using any built-in | ||
| 249 | ;; means for searching. The method specification of the server to | ||
| 250 | ;; search must include a directory for this engine to work (E.g., | ||
| 251 | ;; `nnml-directory'). The tools must be POSIX compliant. GNU Find | ||
| 252 | ;; prior to version 4.2.12 (4.2.26 on Linux due to incorrect ARG_MAX | ||
| 253 | ;; handling) does not work. | ||
| 254 | ;; ,---- | ||
| 255 | ;; | ;; find-grep configuration for searching the Gnus Cache | ||
| 256 | ;; | | ||
| 257 | ;; | (nnml "cache" | ||
| 258 | ;; | (nnml-get-new-mail nil) | ||
| 259 | ;; | (nnir-search-engine find-grep) | ||
| 260 | ;; | (nnml-directory "~/News/cache/") | ||
| 261 | ;; | (nnml-active-file "~/News/cache/active")) | ||
| 262 | ;; `---- | ||
| 263 | |||
| 264 | ;; Developer information: | ||
| 265 | |||
| 266 | ;; I have tried to make the code expandable. Basically, it is divided | ||
| 267 | ;; into two layers. The upper layer is somewhat like the `nnvirtual' | ||
| 268 | ;; or `nnkiboze' backends: given a specification of what articles to | ||
| 269 | ;; show from another backend, it creates a group containing exactly | ||
| 270 | ;; those articles. The lower layer issues a query to a search engine | ||
| 271 | ;; and produces such a specification of what articles to show from the | ||
| 272 | ;; other backend. | ||
| 273 | |||
| 274 | ;; The interface between the two layers consists of the single | ||
| 275 | ;; function `nnir-run-query', which just selects the appropriate | ||
| 276 | ;; function for the search engine one is using. The input to | ||
| 277 | ;; `nnir-run-query' is a string, representing the query as input by | ||
| 278 | ;; the user. The output of `nnir-run-query' is supposed to be a | ||
| 279 | ;; vector, each element of which should in turn be a three-element | ||
| 280 | ;; vector. The first element should be full group name of the article, | ||
| 281 | ;; the second element should be the article number, and the third | ||
| 282 | ;; element should be the Retrieval Status Value (RSV) as returned from | ||
| 283 | ;; the search engine. An RSV is the score assigned to the document by | ||
| 284 | ;; the search engine. For Boolean search engines, the | ||
| 285 | ;; RSV is always 1000 (or 1 or 100, or whatever you like). | ||
| 286 | |||
| 287 | ;; The sorting order of the articles in the summary buffer created by | ||
| 288 | ;; nnir is based on the order of the articles in the above mentioned | ||
| 289 | ;; vector, so that's where you can do the sorting you'd like. Maybe | ||
| 290 | ;; it would be nice to have a way of displaying the search result | ||
| 291 | ;; sorted differently? | ||
| 292 | |||
| 293 | ;; So what do you need to do when you want to add another search | ||
| 294 | ;; engine? You write a function that executes the query. Temporary | ||
| 295 | ;; data from the search engine can be put in `nnir-tmp-buffer'. This | ||
| 296 | ;; function should return the list of articles as a vector, as | ||
| 297 | ;; described above. Then, you need to register this backend in | ||
| 298 | ;; `nnir-engines'. Then, users can choose the backend by setting | ||
| 299 | ;; `nnir-search-engine'. | ||
| 300 | |||
| 301 | ;; Todo, or future ideas: | ||
| 302 | |||
| 303 | ;; * It should be possible to restrict search to certain groups. | ||
| 304 | ;; | ||
| 305 | ;; * There is currently no error checking. | ||
| 306 | ;; | ||
| 307 | ;; * The summary buffer display is currently really ugly, with all the | ||
| 308 | ;; added information in the subjects. How could I make this | ||
| 309 | ;; prettier? | ||
| 310 | ;; | ||
| 311 | ;; * A function which can be called from an nnir summary buffer which | ||
| 312 | ;; teleports you into the group the current article came from and | ||
| 313 | ;; shows you the whole thread this article is part of. | ||
| 314 | ;; Implementation suggestions? | ||
| 315 | ;; (1998-07-24: There is now a preliminary implementation, but | ||
| 316 | ;; it is much too slow and quite fragile.) | ||
| 317 | ;; | ||
| 318 | ;; * Support other mail backends. In particular, probably quite a few | ||
| 319 | ;; people use nnfolder. How would one go about searching nnfolders | ||
| 320 | ;; and producing the right data needed? The group name and the RSV | ||
| 321 | ;; are simple, but what about the article number? | ||
| 322 | ;; - The article number is encoded in the `X-Gnus-Article-Number' | ||
| 323 | ;; header of each mail. | ||
| 324 | ;; - The HyREX engine supports nnfolder. | ||
| 325 | ;; | ||
| 326 | ;; * Support compressed mail files. Probably, just stripping off the | ||
| 327 | ;; `.gz' or `.Z' file name extension is sufficient. | ||
| 328 | ;; | ||
| 329 | ;; * At least for imap, the query is performed twice. | ||
| 330 | ;; | ||
| 331 | |||
| 332 | ;; Have you got other ideas? | ||
| 333 | |||
| 334 | ;;; Setup Code: | ||
| 335 | |||
| 336 | (require 'nnoo) | ||
| 337 | (require 'gnus-group) | ||
| 338 | (require 'gnus-sum) | ||
| 339 | (require 'message) | ||
| 340 | (require 'gnus-util) | ||
| 341 | (eval-and-compile | ||
| 342 | (require 'cl)) | ||
| 343 | |||
| 344 | (nnoo-declare nnir) | ||
| 345 | (nnoo-define-basics nnir) | ||
| 346 | |||
| 347 | (gnus-declare-backend "nnir" 'mail) | ||
| 348 | |||
| 349 | (defvar nnir-imap-search-field "TEXT" | ||
| 350 | "The IMAP search item when doing an nnir search") | ||
| 351 | |||
| 352 | (defvar nnir-imap-search-arguments | ||
| 353 | '(("Whole message" . "TEXT") | ||
| 354 | ("Subject" . "SUBJECT") | ||
| 355 | ("To" . "TO") | ||
| 356 | ("From" . "FROM") | ||
| 357 | (nil . "HEADER \"%s\"")) | ||
| 358 | "Mapping from user readable strings to IMAP search items for use in nnir") | ||
| 359 | |||
| 360 | (defvar nnir-imap-search-argument-history () | ||
| 361 | "The history for querying search options in nnir") | ||
| 362 | |||
| 363 | ;;; Developer Extension Variable: | ||
| 364 | |||
| 365 | (defvar nnir-engines | ||
| 366 | `((wais nnir-run-waissearch | ||
| 367 | ()) | ||
| 368 | (imap nnir-run-imap | ||
| 369 | ((criteria | ||
| 370 | "Search in: " ; Prompt | ||
| 371 | ,nnir-imap-search-arguments ; alist for completing | ||
| 372 | nil ; no filtering | ||
| 373 | nil ; allow any user input | ||
| 374 | nil ; initial value | ||
| 375 | nnir-imap-search-argument-history ; the history to use | ||
| 376 | ,nnir-imap-search-field ; default | ||
| 377 | ))) | ||
| 378 | (swish++ nnir-run-swish++ | ||
| 379 | ((group . "Group spec: "))) | ||
| 380 | (swish-e nnir-run-swish-e | ||
| 381 | ((group . "Group spec: "))) | ||
| 382 | (namazu nnir-run-namazu | ||
| 383 | ()) | ||
| 384 | (hyrex nnir-run-hyrex | ||
| 385 | ((group . "Group spec: "))) | ||
| 386 | (find-grep nnir-run-find-grep | ||
| 387 | ((grep-options . "Grep options: ")))) | ||
| 388 | "Alist of supported search engines. | ||
| 389 | Each element in the alist is a three-element list (ENGINE FUNCTION ARGS). | ||
| 390 | ENGINE is a symbol designating the searching engine. FUNCTION is also | ||
| 391 | a symbol, giving the function that does the search. The third element | ||
| 392 | ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query, | ||
| 393 | the FUNCTION will issue a query for each of the PARAMs, using PROMPT. | ||
| 394 | |||
| 395 | The value of `nnir-search-engine' must be one of the ENGINE symbols. | ||
| 396 | For example, use the following line for searching using freeWAIS-sf: | ||
| 397 | (setq nnir-search-engine 'wais) | ||
| 398 | Use the following line if you read your mail via IMAP and your IMAP | ||
| 399 | server supports searching: | ||
| 400 | (setq nnir-search-engine 'imap) | ||
| 401 | Note that you have to set additional variables for most backends. For | ||
| 402 | example, the `wais' backend needs the variables `nnir-wais-program', | ||
| 403 | `nnir-wais-database' and `nnir-wais-remove-prefix'. | ||
| 404 | |||
| 405 | Add an entry here when adding a new search engine.") | ||
| 406 | |||
| 407 | ;;; User Customizable Variables: | ||
| 408 | |||
| 409 | (defgroup nnir nil | ||
| 410 | "Search nnmh and nnml groups in Gnus with swish-e, freeWAIS-sf, or EWS." | ||
| 411 | :group 'gnus) | ||
| 412 | |||
| 413 | ;; Mail backend. | ||
| 414 | |||
| 415 | ;; TODO: | ||
| 416 | ;; If `nil', use server parameters to find out which server to search. CCC | ||
| 417 | ;; | ||
| 418 | (defcustom nnir-mail-backend '(nnml "") | ||
| 419 | "*Specifies which backend should be searched. | ||
| 420 | More precisely, this is used to determine from which backend to fetch the | ||
| 421 | messages found. | ||
| 422 | |||
| 423 | This must be equal to an existing server, so maybe it is best to use | ||
| 424 | something like the following: | ||
| 425 | (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods)) | ||
| 426 | The above line works fine if the mail backend you want to search is | ||
| 427 | the first element of gnus-secondary-select-methods (`nth' starts counting | ||
| 428 | at zero)." | ||
| 429 | :type '(sexp) | ||
| 430 | :group 'nnir) | ||
| 431 | |||
| 432 | ;; Search engine to use. | ||
| 433 | |||
| 434 | (defcustom nnir-search-engine 'wais | ||
| 435 | "*The search engine to use. Must be a symbol. | ||
| 436 | See `nnir-engines' for a list of supported engines, and for example | ||
| 437 | settings of `nnir-search-engine'." | ||
| 438 | :type '(sexp) | ||
| 439 | :group 'nnir) | ||
| 440 | |||
| 441 | ;; freeWAIS-sf. | ||
| 442 | |||
| 443 | (defcustom nnir-wais-program "waissearch" | ||
| 444 | "*Name of waissearch executable." | ||
| 445 | :type '(string) | ||
| 446 | :group 'nnir) | ||
| 447 | |||
| 448 | (defcustom nnir-wais-database (expand-file-name "~/.wais/mail") | ||
| 449 | "*Name of Wais database containing the mail. | ||
| 450 | |||
| 451 | Note that this should be a file name without extension. For example, | ||
| 452 | if you have a file /home/john/.wais/mail.fmt, use this: | ||
| 453 | (setq nnir-wais-database \"/home/john/.wais/mail\") | ||
| 454 | The string given here is passed to `waissearch -d' as-is." | ||
| 455 | :type '(file) | ||
| 456 | :group 'nnir) | ||
| 457 | |||
| 458 | (defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/") | ||
| 459 | "*The prefix to remove from each directory name returned by waissearch | ||
| 460 | in order to get a group name (albeit with / instead of .). This is a | ||
| 461 | regular expression. | ||
| 462 | |||
| 463 | For example, suppose that Wais returns file names such as | ||
| 464 | \"/home/john/Mail/mail/misc/42\". For this example, use the following | ||
| 465 | setting: (setq nnir-wais-remove-prefix \"/home/john/Mail/\") | ||
| 466 | Note the trailing slash. Removing this prefix gives \"mail/misc/42\". | ||
| 467 | `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to | ||
| 468 | arrive at the correct group name, \"mail.misc\"." | ||
| 469 | :type '(regexp) | ||
| 470 | :group 'nnir) | ||
| 471 | |||
| 472 | (defcustom nnir-swish++-configuration-file | ||
| 473 | (expand-file-name "~/Mail/swish++.conf") | ||
| 474 | "*Configuration file for swish++." | ||
| 475 | :type '(file) | ||
| 476 | :group 'nnir) | ||
| 477 | |||
| 478 | (defcustom nnir-swish++-program "search" | ||
| 479 | "*Name of swish++ search executable." | ||
| 480 | :type '(string) | ||
| 481 | :group 'nnir) | ||
| 482 | |||
| 483 | (defcustom nnir-swish++-additional-switches '() | ||
| 484 | "*A list of strings, to be given as additional arguments to swish++. | ||
| 485 | |||
| 486 | Note that this should be a list. Ie, do NOT use the following: | ||
| 487 | (setq nnir-swish++-additional-switches \"-i -w\") ; wrong | ||
| 488 | Instead, use this: | ||
| 489 | (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))" | ||
| 490 | :type '(repeat (string)) | ||
| 491 | :group 'nnir) | ||
| 492 | |||
| 493 | (defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/") | ||
| 494 | "*The prefix to remove from each file name returned by swish++ | ||
| 495 | in order to get a group name (albeit with / instead of .). This is a | ||
| 496 | regular expression. | ||
| 497 | |||
| 498 | This variable is very similar to `nnir-wais-remove-prefix', except | ||
| 499 | that it is for swish++, not Wais." | ||
| 500 | :type '(regexp) | ||
| 501 | :group 'nnir) | ||
| 502 | |||
| 503 | ;; Swish-E. | ||
| 504 | ;; URL: http://sunsite.berkeley.edu/SWISH-E/ | ||
| 505 | ;; New version: http://www.boe.es/swish-e | ||
| 506 | ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and | ||
| 507 | ;; `nnir-swish-e-additional-switches' | ||
| 508 | |||
| 509 | (make-obsolete-variable 'nnir-swish-e-index-file | ||
| 510 | 'nnir-swish-e-index-files) | ||
| 511 | (defcustom nnir-swish-e-index-file | ||
| 512 | (expand-file-name "~/Mail/index.swish-e") | ||
| 513 | "*Index file for swish-e. | ||
| 514 | This could be a server parameter. | ||
| 515 | It is never consulted once `nnir-swish-e-index-files', which should be | ||
| 516 | used instead, has been customized." | ||
| 517 | :type '(file) | ||
| 518 | :group 'nnir) | ||
| 519 | |||
| 520 | (defcustom nnir-swish-e-index-files | ||
| 521 | (list nnir-swish-e-index-file) | ||
| 522 | "*List of index files for swish-e. | ||
| 523 | This could be a server parameter." | ||
| 524 | :type '(repeat (file)) | ||
| 525 | :group 'nnir) | ||
| 526 | |||
| 527 | (defcustom nnir-swish-e-program "swish-e" | ||
| 528 | "*Name of swish-e search executable. | ||
| 529 | This cannot be a server parameter." | ||
| 530 | :type '(string) | ||
| 531 | :group 'nnir) | ||
| 532 | |||
| 533 | (defcustom nnir-swish-e-additional-switches '() | ||
| 534 | "*A list of strings, to be given as additional arguments to swish-e. | ||
| 535 | |||
| 536 | Note that this should be a list. Ie, do NOT use the following: | ||
| 537 | (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong | ||
| 538 | Instead, use this: | ||
| 539 | (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\")) | ||
| 540 | |||
| 541 | This could be a server parameter." | ||
| 542 | :type '(repeat (string)) | ||
| 543 | :group 'nnir) | ||
| 544 | |||
| 545 | (defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/") | ||
| 546 | "*The prefix to remove from each file name returned by swish-e | ||
| 547 | in order to get a group name (albeit with / instead of .). This is a | ||
| 548 | regular expression. | ||
| 549 | |||
| 550 | This variable is very similar to `nnir-wais-remove-prefix', except | ||
| 551 | that it is for swish-e, not Wais. | ||
| 552 | |||
| 553 | This could be a server parameter." | ||
| 554 | :type '(regexp) | ||
| 555 | :group 'nnir) | ||
| 556 | |||
| 557 | ;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/> | ||
| 558 | |||
| 559 | (defcustom nnir-hyrex-program "nnir-search" | ||
| 560 | "*Name of the nnir-search executable." | ||
| 561 | :type '(string) | ||
| 562 | :group 'nnir) | ||
| 563 | |||
| 564 | (defcustom nnir-hyrex-additional-switches '() | ||
| 565 | "*A list of strings, to be given as additional arguments for nnir-search. | ||
| 566 | Note that this should be a list. Ie, do NOT use the following: | ||
| 567 | (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong ! | ||
| 568 | Instead, use this: | ||
| 569 | (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))" | ||
| 570 | :type '(repeat (string)) | ||
| 571 | :group 'nnir) | ||
| 572 | |||
| 573 | (defcustom nnir-hyrex-index-directory (getenv "HOME") | ||
| 574 | "*Index directory for HyREX." | ||
| 575 | :type '(directory) | ||
| 576 | :group 'nnir) | ||
| 577 | |||
| 578 | (defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/") | ||
| 579 | "*The prefix to remove from each file name returned by HyREX | ||
| 580 | in order to get a group name (albeit with / instead of .). | ||
| 581 | |||
| 582 | For example, suppose that HyREX returns file names such as | ||
| 583 | \"/home/john/Mail/mail/misc/42\". For this example, use the following | ||
| 584 | setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\") | ||
| 585 | Note the trailing slash. Removing this prefix gives \"mail/misc/42\". | ||
| 586 | `nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to | ||
| 587 | arrive at the correct group name, \"mail.misc\"." | ||
| 588 | :type '(directory) | ||
| 589 | :group 'nnir) | ||
| 590 | |||
| 591 | ;; Namazu engine, see <URL:http://ww.namazu.org/> | ||
| 592 | |||
| 593 | (defcustom nnir-namazu-program "namazu" | ||
| 594 | "*Name of Namazu search executable." | ||
| 595 | :type '(string) | ||
| 596 | :group 'nnir) | ||
| 597 | |||
| 598 | (defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/") | ||
| 599 | "*Index directory for Namazu." | ||
| 600 | :type '(directory) | ||
| 601 | :group 'nnir) | ||
| 602 | |||
| 603 | (defcustom nnir-namazu-additional-switches '() | ||
| 604 | "*A list of strings, to be given as additional arguments to namazu. | ||
| 605 | The switches `-q', `-a', and `-s' are always used, very few other switches | ||
| 606 | make any sense in this context. | ||
| 607 | |||
| 608 | Note that this should be a list. Ie, do NOT use the following: | ||
| 609 | (setq nnir-namazu-additional-switches \"-i -w\") ; wrong | ||
| 610 | Instead, use this: | ||
| 611 | (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))" | ||
| 612 | :type '(repeat (string)) | ||
| 613 | :group 'nnir) | ||
| 614 | |||
| 615 | (defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/") | ||
| 616 | "*The prefix to remove from each file name returned by Namazu | ||
| 617 | in order to get a group name (albeit with / instead of .). | ||
| 618 | |||
| 619 | This variable is very similar to `nnir-wais-remove-prefix', except | ||
| 620 | that it is for Namazu, not Wais." | ||
| 621 | :type '(directory) | ||
| 622 | :group 'nnir) | ||
| 623 | |||
| 624 | ;;; Internal Variables: | ||
| 625 | |||
| 626 | (defvar nnir-current-query nil | ||
| 627 | "Internal: stores current query (= group name).") | ||
| 628 | |||
| 629 | (defvar nnir-current-server nil | ||
| 630 | "Internal: stores current server (does it ever change?).") | ||
| 631 | |||
| 632 | (defvar nnir-current-group-marked nil | ||
| 633 | "Internal: stores current list of process-marked groups.") | ||
| 634 | |||
| 635 | (defvar nnir-artlist nil | ||
| 636 | "Internal: stores search result.") | ||
| 637 | |||
| 638 | (defvar nnir-tmp-buffer " *nnir*" | ||
| 639 | "Internal: temporary buffer.") | ||
| 640 | |||
| 641 | ;;; Code: | ||
| 642 | |||
| 643 | ;; Gnus glue. | ||
| 644 | |||
| 645 | (defun gnus-group-make-nnir-group (extra-parms query) | ||
| 646 | "Create an nnir group. Asks for query." | ||
| 647 | (interactive "P\nsQuery: ") | ||
| 648 | (setq nnir-current-query nil | ||
| 649 | nnir-current-server nil | ||
| 650 | nnir-current-group-marked nil | ||
| 651 | nnir-artlist nil) | ||
| 652 | (let ((parms nil)) | ||
| 653 | (if extra-parms | ||
| 654 | (setq parms (nnir-read-parms query)) | ||
| 655 | (setq parms (list (cons 'query query)))) | ||
| 656 | (add-to-list 'parms (cons 'unique-id (message-unique-id)) t) | ||
| 657 | (gnus-group-read-ephemeral-group | ||
| 658 | (concat "nnir:" (prin1-to-string parms)) '(nnir "") t | ||
| 659 | (cons (current-buffer) | ||
| 660 | gnus-current-window-configuration) | ||
| 661 | nil))) | ||
| 662 | |||
| 663 | (defun nnir-group-mode-hook () | ||
| 664 | (define-key gnus-group-mode-map (kbd "G G") | ||
| 665 | 'gnus-group-make-nnir-group)) | ||
| 666 | (add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook) | ||
| 667 | |||
| 668 | ;; Why is this needed? Is this for compatibility with old/new gnusae? Using | ||
| 669 | ;; gnus-group-server instead works for me. -- Justus Piater | ||
| 670 | (defmacro nnir-group-server (group) | ||
| 671 | "Return the server for a newsgroup GROUP. | ||
| 672 | The returned format is as `gnus-server-to-method' needs it. See | ||
| 673 | `gnus-group-real-prefix' and `gnus-group-real-name'." | ||
| 674 | `(let ((gname ,group)) | ||
| 675 | (if (string-match "^\\([^:]+\\):" gname) | ||
| 676 | (progn | ||
| 677 | (setq gname (match-string 1 gname)) | ||
| 678 | (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname) | ||
| 679 | (format "%s:%s" (match-string 1 gname) (match-string 2 gname)) | ||
| 680 | (concat gname ":"))) | ||
| 681 | (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method))))) | ||
| 682 | |||
| 683 | ;; Summary mode commands. | ||
| 684 | |||
| 685 | (defun gnus-summary-nnir-goto-thread () | ||
| 686 | "Only applies to nnir groups. Go to group this article came from | ||
| 687 | and show thread that contains this article." | ||
| 688 | (interactive) | ||
| 689 | (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name))) | ||
| 690 | (error "Can't execute this command unless in nnir group.")) | ||
| 691 | (let* ((cur (gnus-summary-article-number)) | ||
| 692 | (group (nnir-artlist-artitem-group nnir-artlist cur)) | ||
| 693 | (backend-number (nnir-artlist-artitem-number nnir-artlist cur)) | ||
| 694 | server backend-group) | ||
| 695 | (setq server (nnir-group-server group)) | ||
| 696 | (setq backend-group (gnus-group-real-name group)) | ||
| 697 | (gnus-group-read-ephemeral-group | ||
| 698 | backend-group | ||
| 699 | (gnus-server-to-method server) | ||
| 700 | t ; activate | ||
| 701 | (cons (current-buffer) | ||
| 702 | 'summary) ; window config | ||
| 703 | nil | ||
| 704 | (list backend-number)) | ||
| 705 | (gnus-summary-limit (list backend-number)) | ||
| 706 | (gnus-summary-refer-thread))) | ||
| 707 | |||
| 708 | (if (fboundp 'eval-after-load) | ||
| 709 | (eval-after-load "gnus-sum" | ||
| 710 | '(define-key gnus-summary-goto-map | ||
| 711 | "T" 'gnus-summary-nnir-goto-thread)) | ||
| 712 | (add-hook 'gnus-summary-mode-hook | ||
| 713 | (function (lambda () | ||
| 714 | (define-key gnus-summary-goto-map | ||
| 715 | "T" 'gnus-summary-nnir-goto-thread))))) | ||
| 716 | |||
| 717 | |||
| 718 | |||
| 719 | ;; Gnus backend interface functions. | ||
| 720 | |||
| 721 | (deffoo nnir-open-server (server &optional definitions) | ||
| 722 | ;; Just set the server variables appropriately. | ||
| 723 | (nnoo-change-server 'nnir server definitions)) | ||
| 724 | |||
| 725 | (deffoo nnir-request-group (group &optional server fast) | ||
| 726 | "GROUP is the query string." | ||
| 727 | (nnir-possibly-change-server server) | ||
| 728 | ;; Check for cache and return that if appropriate. | ||
| 729 | (if (and (equal group nnir-current-query) | ||
| 730 | (equal gnus-group-marked nnir-current-group-marked) | ||
| 731 | (or (null server) | ||
| 732 | (equal server nnir-current-server))) | ||
| 733 | nnir-artlist | ||
| 734 | ;; Cache miss. | ||
| 735 | (setq nnir-artlist (nnir-run-query group))) | ||
| 736 | (save-excursion | ||
| 737 | (set-buffer nntp-server-buffer) | ||
| 738 | (if (zerop (length nnir-artlist)) | ||
| 739 | (progn | ||
| 740 | (setq nnir-current-query nil | ||
| 741 | nnir-current-server nil | ||
| 742 | nnir-current-group-marked nil | ||
| 743 | nnir-artlist nil) | ||
| 744 | (nnheader-report 'nnir "Search produced empty results.")) | ||
| 745 | ;; Remember data for cache. | ||
| 746 | (setq nnir-current-query group) | ||
| 747 | (when server (setq nnir-current-server server)) | ||
| 748 | (setq nnir-current-group-marked gnus-group-marked) | ||
| 749 | (nnheader-insert "211 %d %d %d %s\n" | ||
| 750 | (nnir-artlist-length nnir-artlist) ; total # | ||
| 751 | 1 ; first # | ||
| 752 | (nnir-artlist-length nnir-artlist) ; last # | ||
| 753 | group)))) ; group name | ||
| 754 | |||
| 755 | (deffoo nnir-retrieve-headers (articles &optional group server fetch-old) | ||
| 756 | (save-excursion | ||
| 757 | (let ((artlist (copy-sequence articles)) | ||
| 758 | art artitem artgroup artno artrsv artfullgroup | ||
| 759 | novitem novdata foo server) | ||
| 760 | (while (not (null artlist)) | ||
| 761 | (setq art (car artlist)) | ||
| 762 | (or (numberp art) | ||
| 763 | (nnheader-report | ||
| 764 | 'nnir | ||
| 765 | "nnir-retrieve-headers doesn't grok message ids: %s" | ||
| 766 | art)) | ||
| 767 | (setq artitem (nnir-artlist-article nnir-artlist art)) | ||
| 768 | (setq artrsv (nnir-artitem-rsv artitem)) | ||
| 769 | (setq artfullgroup (nnir-artitem-group artitem)) | ||
| 770 | (setq artno (nnir-artitem-number artitem)) | ||
| 771 | (setq artgroup (gnus-group-real-name artfullgroup)) | ||
| 772 | (setq server (nnir-group-server artfullgroup)) | ||
| 773 | ;; retrieve NOV or HEAD data for this article, transform into | ||
| 774 | ;; NOV data and prepend to `novdata' | ||
| 775 | (set-buffer nntp-server-buffer) | ||
| 776 | (nnir-possibly-change-server server) | ||
| 777 | (let ((gnus-override-method | ||
| 778 | (gnus-server-to-method server))) | ||
| 779 | (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil)) | ||
| 780 | (nov | ||
| 781 | (goto-char (point-min)) | ||
| 782 | (setq novitem (nnheader-parse-nov)) | ||
| 783 | (unless novitem | ||
| 784 | (pop-to-buffer nntp-server-buffer) | ||
| 785 | (error | ||
| 786 | "nnheader-parse-nov returned nil for article %s in group %s" | ||
| 787 | artno artfullgroup))) | ||
| 788 | (headers | ||
| 789 | (goto-char (point-min)) | ||
| 790 | (setq novitem (nnheader-parse-head)) | ||
| 791 | (unless novitem | ||
| 792 | (pop-to-buffer nntp-server-buffer) | ||
| 793 | (error | ||
| 794 | "nnheader-parse-head returned nil for article %s in group %s" | ||
| 795 | artno artfullgroup))) | ||
| 796 | (t (error "Unknown header type %s while requesting article %s of group %s" | ||
| 797 | foo artno artfullgroup)))) | ||
| 798 | ;; replace article number in original group with article number | ||
| 799 | ;; in nnir group | ||
| 800 | (mail-header-set-number novitem art) | ||
| 801 | (mail-header-set-from novitem | ||
| 802 | (mail-header-from novitem)) | ||
| 803 | (mail-header-set-subject | ||
| 804 | novitem | ||
| 805 | (format "[%d: %s/%d] %s" | ||
| 806 | artrsv artgroup artno | ||
| 807 | (mail-header-subject novitem))) | ||
| 808 | ;;-(mail-header-set-extra novitem nil) | ||
| 809 | (push novitem novdata) | ||
| 810 | (setq artlist (cdr artlist))) | ||
| 811 | (setq novdata (nreverse novdata)) | ||
| 812 | (set-buffer nntp-server-buffer) (erase-buffer) | ||
| 813 | (mapc 'nnheader-insert-nov novdata) | ||
| 814 | 'nov))) | ||
| 815 | |||
| 816 | (deffoo nnir-request-article (article | ||
| 817 | &optional group server to-buffer) | ||
| 818 | (if (stringp article) | ||
| 819 | (nnheader-report | ||
| 820 | 'nnir | ||
| 821 | "nnir-retrieve-headers doesn't grok message ids: %s" | ||
| 822 | article) | ||
| 823 | (save-excursion | ||
| 824 | (let* ((artitem (nnir-artlist-article nnir-artlist | ||
| 825 | article)) | ||
| 826 | (artfullgroup (nnir-artitem-group artitem)) | ||
| 827 | (artno (nnir-artitem-number artitem)) | ||
| 828 | ;; Bug? | ||
| 829 | ;; Why must we bind nntp-server-buffer here? It won't | ||
| 830 | ;; work if `buf' is used, say. (Of course, the set-buffer | ||
| 831 | ;; line below must then be updated, too.) | ||
| 832 | (nntp-server-buffer (or to-buffer nntp-server-buffer))) | ||
| 833 | (set-buffer nntp-server-buffer) | ||
| 834 | (erase-buffer) | ||
| 835 | (message "Requesting article %d from group %s" | ||
| 836 | artno artfullgroup) | ||
| 837 | (gnus-request-article artno artfullgroup nntp-server-buffer) | ||
| 838 | (cons artfullgroup artno))))) | ||
| 839 | |||
| 840 | |||
| 841 | (nnoo-define-skeleton nnir) | ||
| 842 | |||
| 843 | |||
| 844 | (defmacro nnir-add-result (dirnam artno score prefix server artlist) | ||
| 845 | "Ask `nnir-compose-result' to construct a result vector, | ||
| 846 | and if it is non-nil, add it to artlist." | ||
| 847 | `(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server))) | ||
| 848 | (when (not (null result)) | ||
| 849 | (push result ,artlist)))) | ||
| 850 | |||
| 851 | (autoload 'nnmaildir-base-name-to-article-number "nnmaildir") | ||
| 852 | |||
| 853 | ;; Helper function currently used by the Swish++ and Namazu backends; | ||
| 854 | ;; perhaps useful for other backends as well | ||
| 855 | (defun nnir-compose-result (dirnam article score prefix server) | ||
| 856 | "Extract the group from dirnam, and create a result vector | ||
| 857 | ready to be added to the list of search results." | ||
| 858 | |||
| 859 | ;; remove nnir-*-remove-prefix from beginning of dirnam filename | ||
| 860 | (when (string-match (concat "^" prefix) dirnam) | ||
| 861 | (setq dirnam (replace-match "" t t dirnam))) | ||
| 862 | |||
| 863 | (when (file-readable-p (concat prefix dirnam article)) | ||
| 864 | ;; remove trailing slash and, for nnmaildir, cur/new/tmp | ||
| 865 | (setq dirnam | ||
| 866 | (substring dirnam 0 (if (string= server "nnmaildir:") -5 -1))) | ||
| 867 | |||
| 868 | ;; Set group to dirnam without any leading dots or slashes, | ||
| 869 | ;; and with all subsequent slashes replaced by dots | ||
| 870 | (let ((group (gnus-replace-in-string | ||
| 871 | (gnus-replace-in-string dirnam "^[./\\]" "" t) | ||
| 872 | "[/\\]" "." t))) | ||
| 873 | |||
| 874 | (vector (nnir-group-full-name group server) | ||
| 875 | (if (string= server "nnmaildir:") | ||
| 876 | (nnmaildir-base-name-to-article-number | ||
| 877 | (substring article 0 (string-match ":" article)) | ||
| 878 | group nil) | ||
| 879 | (string-to-number article)) | ||
| 880 | (string-to-number score))))) | ||
| 881 | |||
| 882 | ;;; Search Engine Interfaces: | ||
| 883 | |||
| 884 | ;; freeWAIS-sf interface. | ||
| 885 | (defun nnir-run-waissearch (query server &optional group) | ||
| 886 | "Run given query agains waissearch. Returns vector of (group name, file name) | ||
| 887 | pairs (also vectors, actually)." | ||
| 888 | (when group | ||
| 889 | (error "The freeWAIS-sf backend cannot search specific groups.")) | ||
| 890 | (save-excursion | ||
| 891 | (let ((qstring (cdr (assq 'query query))) | ||
| 892 | (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server)) | ||
| 893 | artlist score artno dirnam) | ||
| 894 | (set-buffer (get-buffer-create nnir-tmp-buffer)) | ||
| 895 | (erase-buffer) | ||
| 896 | (message "Doing WAIS query %s..." query) | ||
| 897 | (call-process nnir-wais-program | ||
| 898 | nil ; input from /dev/null | ||
| 899 | t ; output to current buffer | ||
| 900 | nil ; don't redisplay | ||
| 901 | "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search | ||
| 902 | qstring) | ||
| 903 | (message "Massaging waissearch output...") | ||
| 904 | ;; remove superfluous lines | ||
| 905 | (keep-lines "Score:") | ||
| 906 | ;; extract data from result lines | ||
| 907 | (goto-char (point-min)) | ||
| 908 | (while (re-search-forward | ||
| 909 | "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t) | ||
| 910 | (setq score (match-string 1) | ||
| 911 | artno (match-string 2) | ||
| 912 | dirnam (match-string 3)) | ||
| 913 | (unless (string-match prefix dirnam) | ||
| 914 | (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s" | ||
| 915 | dirnam prefix)) | ||
| 916 | (setq group (substitute ?. ?/ (replace-match "" t t dirnam))) | ||
| 917 | (push (vector (nnir-group-full-name group server) | ||
| 918 | (string-to-number artno) | ||
| 919 | (string-to-number score)) | ||
| 920 | artlist)) | ||
| 921 | (message "Massaging waissearch output...done") | ||
| 922 | (apply 'vector | ||
| 923 | (sort* artlist | ||
| 924 | (function (lambda (x y) | ||
| 925 | (> (nnir-artitem-rsv x) | ||
| 926 | (nnir-artitem-rsv y))))))))) | ||
| 927 | |||
| 928 | ;; IMAP interface. | ||
| 929 | ;; todo: | ||
| 930 | ;; nnir invokes this two (2) times???! | ||
| 931 | ;; we should not use nnimap at all but open our own server connection | ||
| 932 | ;; we should not LIST * but use nnimap-list-pattern from defs | ||
| 933 | ;; send queries as literals | ||
| 934 | ;; handle errors | ||
| 935 | |||
| 936 | (autoload 'nnimap-open-server "nnimap") | ||
| 937 | (defvar nnimap-server-buffer) ;; nnimap.el | ||
| 938 | (autoload 'imap-mailbox-select "imap") | ||
| 939 | (autoload 'imap-search "imap") | ||
| 940 | (autoload 'imap-quote-specials "imap") | ||
| 941 | |||
| 942 | (defun nnir-run-imap (query srv &optional group-option) | ||
| 943 | "Run a search against an IMAP back-end server. | ||
| 944 | This uses a custom query language parser; see `nnir-imap-make-query' for | ||
| 945 | details on the language and supported extensions" | ||
| 946 | (save-excursion | ||
| 947 | (let ((qstring (cdr (assq 'query query))) | ||
| 948 | (server (cadr (gnus-server-to-method srv))) | ||
| 949 | (group (or group-option (gnus-group-group-name))) | ||
| 950 | (defs (caddr (gnus-server-to-method srv))) | ||
| 951 | (criteria (or (cdr (assq 'criteria query)) | ||
| 952 | nnir-imap-search-field)) | ||
| 953 | artlist buf) | ||
| 954 | (message "Opening server %s" server) | ||
| 955 | (condition-case () | ||
| 956 | (when (nnimap-open-server server defs) ;; xxx | ||
| 957 | (setq buf nnimap-server-buffer) ;; xxx | ||
| 958 | (message "Searching %s..." group) | ||
| 959 | (let ((arts 0) | ||
| 960 | (mbx (gnus-group-real-name group))) | ||
| 961 | (when (imap-mailbox-select mbx nil buf) | ||
| 962 | (mapc | ||
| 963 | (lambda (artnum) | ||
| 964 | (push (vector group artnum 1) artlist) | ||
| 965 | (setq arts (1+ arts))) | ||
| 966 | (imap-search (nnir-imap-make-query criteria qstring) buf)) | ||
| 967 | (message "Searching %s... %d matches" mbx arts))) | ||
| 968 | (message "Searching %s...done" group)) | ||
| 969 | (quit nil)) | ||
| 970 | (reverse artlist)))) | ||
| 971 | |||
| 972 | (defun nnir-imap-make-query (criteria qstring) | ||
| 973 | "Parse the query string and criteria into an appropriate IMAP search | ||
| 974 | expression, returning the string query to make. | ||
| 975 | |||
| 976 | This implements a little language designed to return the expected results | ||
| 977 | to an arbitrary query string to the end user. | ||
| 978 | |||
| 979 | The search is always case-insensitive, as defined by RFC2060, and supports | ||
| 980 | the following features (inspired by the Google search input language): | ||
| 981 | |||
| 982 | Automatic \"and\" queries | ||
| 983 | If you specify multiple words then they will be treated as an \"and\" | ||
| 984 | expression intended to match all components. | ||
| 985 | |||
| 986 | Phrase searches | ||
| 987 | If you wrap your query in double-quotes then it will be treated as a | ||
| 988 | literal string. | ||
| 989 | |||
| 990 | Negative terms | ||
| 991 | If you precede a term with \"-\" then it will negate that. | ||
| 992 | |||
| 993 | \"OR\" queries | ||
| 994 | If you include an upper-case \"OR\" in your search it will cause the | ||
| 995 | term before it and the term after it to be treated as alternatives. | ||
| 996 | |||
| 997 | In future the following will be added to the language: | ||
| 998 | * support for date matches | ||
| 999 | * support for location of text matching within the query | ||
| 1000 | * from/to/etc headers | ||
| 1001 | * additional search terms | ||
| 1002 | * flag based searching | ||
| 1003 | * anything else that the RFC supports, basically." | ||
| 1004 | ;; Walk through the query and turn it into an IMAP query string. | ||
| 1005 | (nnir-imap-query-to-imap criteria (nnir-imap-parse-query qstring))) | ||
| 1006 | |||
| 1007 | |||
| 1008 | (defun nnir-imap-query-to-imap (criteria query) | ||
| 1009 | "Turn a s-expression format query into IMAP." | ||
| 1010 | (mapconcat | ||
| 1011 | ;; Turn the expressions into IMAP text | ||
| 1012 | (lambda (item) | ||
| 1013 | (nnir-imap-expr-to-imap criteria item)) | ||
| 1014 | ;; The query, already in s-expr format. | ||
| 1015 | query | ||
| 1016 | ;; Append a space between each expression | ||
| 1017 | " ")) | ||
| 1018 | |||
| 1019 | |||
| 1020 | (defun nnir-imap-expr-to-imap (criteria expr) | ||
| 1021 | "Convert EXPR into an IMAP search expression on CRITERIA" | ||
| 1022 | ;; What sort of expression is this, eh? | ||
| 1023 | (cond | ||
| 1024 | ;; Simple string term | ||
| 1025 | ((stringp expr) | ||
| 1026 | (format "%s \"%s\"" criteria (imap-quote-specials expr))) | ||
| 1027 | ;; Trivial term: and | ||
| 1028 | ((eq expr 'and) nil) | ||
| 1029 | ;; Composite term: or expression | ||
| 1030 | ((eq (car-safe expr) 'or) | ||
| 1031 | (format "OR %s %s" | ||
| 1032 | (nnir-imap-expr-to-imap criteria (second expr)) | ||
| 1033 | (nnir-imap-expr-to-imap criteria (third expr)))) | ||
| 1034 | ;; Composite term: just the fax, mam | ||
| 1035 | ((eq (car-safe expr) 'not) | ||
| 1036 | (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr)))) | ||
| 1037 | ;; Composite term: just expand it all. | ||
| 1038 | ((and (not (null expr)) (listp expr)) | ||
| 1039 | (format "(%s)" (nnir-imap-query-to-imap criteria expr))) | ||
| 1040 | ;; Complex value, give up for now. | ||
| 1041 | (t (error "Unhandled input: %S" expr)))) | ||
| 1042 | |||
| 1043 | |||
| 1044 | (defun nnir-imap-parse-query (string) | ||
| 1045 | "Turn STRING into an s-expression based query based on the IMAP | ||
| 1046 | query language as defined in `nnir-imap-make-query'. | ||
| 1047 | |||
| 1048 | This involves turning individual tokens into higher level terms | ||
| 1049 | that the search language can then understand and use." | ||
| 1050 | (with-temp-buffer | ||
| 1051 | ;; Set up the parsing environment. | ||
| 1052 | (insert string) | ||
| 1053 | (goto-char (point-min)) | ||
| 1054 | ;; Now, collect the output terms and return them. | ||
| 1055 | (let (out) | ||
| 1056 | (while (not (nnir-imap-end-of-input)) | ||
| 1057 | (push (nnir-imap-next-expr) out)) | ||
| 1058 | (reverse out)))) | ||
| 1059 | |||
| 1060 | |||
| 1061 | (defun nnir-imap-next-expr (&optional count) | ||
| 1062 | "Return the next expression from the current buffer." | ||
| 1063 | (let ((term (nnir-imap-next-term count)) | ||
| 1064 | (next (nnir-imap-peek-symbol))) | ||
| 1065 | ;; Are we looking at an 'or' expression? | ||
| 1066 | (cond | ||
| 1067 | ;; Handle 'expr or expr' | ||
| 1068 | ((eq next 'or) | ||
| 1069 | (list 'or term (nnir-imap-next-expr 2))) | ||
| 1070 | ;; Anything else | ||
| 1071 | (t term)))) | ||
| 1072 | |||
| 1073 | |||
| 1074 | (defun nnir-imap-next-term (&optional count) | ||
| 1075 | "Return the next TERM from the current buffer." | ||
| 1076 | (let ((term (nnir-imap-next-symbol count))) | ||
| 1077 | ;; What sort of term is this? | ||
| 1078 | (cond | ||
| 1079 | ;; and -- just ignore it | ||
| 1080 | ((eq term 'and) 'and) | ||
| 1081 | ;; negated term | ||
| 1082 | ((eq term 'not) (list 'not (nnir-imap-next-expr))) | ||
| 1083 | ;; generic term | ||
| 1084 | (t term)))) | ||
| 1085 | |||
| 1086 | |||
| 1087 | (defun nnir-imap-peek-symbol () | ||
| 1088 | "Return the next symbol from the current buffer, but don't consume it." | ||
| 1089 | (save-excursion | ||
| 1090 | (nnir-imap-next-symbol))) | ||
| 1091 | |||
| 1092 | (defun nnir-imap-next-symbol (&optional count) | ||
| 1093 | "Return the next symbol from the current buffer, or nil if we are | ||
| 1094 | at the end of the buffer. If supplied COUNT skips some symbols before | ||
| 1095 | returning the one at the supplied position." | ||
| 1096 | (when (and (numberp count) (> count 1)) | ||
| 1097 | (nnir-imap-next-symbol (1- count))) | ||
| 1098 | (let ((case-fold-search t)) | ||
| 1099 | ;; end of input stream? | ||
| 1100 | (unless (nnir-imap-end-of-input) | ||
| 1101 | ;; No, return the next symbol from the stream. | ||
| 1102 | (cond | ||
| 1103 | ;; negated expression -- return it and advance one char. | ||
| 1104 | ((looking-at "-") (forward-char 1) 'not) | ||
| 1105 | ;; quoted string | ||
| 1106 | ((looking-at "\"") (nnir-imap-delimited-string "\"")) | ||
| 1107 | ;; list expression -- we parse the content and return this as a list. | ||
| 1108 | ((looking-at "(") | ||
| 1109 | (nnir-imap-parse-query (nnir-imap-delimited-string ")"))) | ||
| 1110 | ;; keyword input -- return a symbol version | ||
| 1111 | ((looking-at "\\band\\b") (forward-char 3) 'and) | ||
| 1112 | ((looking-at "\\bor\\b") (forward-char 2) 'or) | ||
| 1113 | ((looking-at "\\bnot\\b") (forward-char 3) 'not) | ||
| 1114 | ;; Simple, boring keyword | ||
| 1115 | (t (let ((start (point)) | ||
| 1116 | (end (if (search-forward-regexp "[[:blank:]]" nil t) | ||
| 1117 | (prog1 | ||
| 1118 | (match-beginning 0) | ||
| 1119 | ;; unskip if we hit a non-blank terminal character. | ||
| 1120 | (when (string-match "[^[:blank:]]" (match-string 0)) | ||
| 1121 | (backward-char 1))) | ||
| 1122 | (goto-char (point-max))))) | ||
| 1123 | (buffer-substring start end))))))) | ||
| 1124 | |||
| 1125 | (defun nnir-imap-delimited-string (delimiter) | ||
| 1126 | "Return a delimited string from the current buffer." | ||
| 1127 | (let ((start (point)) end) | ||
| 1128 | (forward-char 1) ; skip the first delimiter. | ||
| 1129 | (while (not end) | ||
| 1130 | (unless (search-forward delimiter nil t) | ||
| 1131 | (error "Unmatched delimited input with %s in query" delimiter)) | ||
| 1132 | (let ((here (point))) | ||
| 1133 | (unless (equal (buffer-substring (- here 2) (- here 1)) "\\") | ||
| 1134 | (setq end (point))))) | ||
| 1135 | (buffer-substring (1+ start) (1- end)))) | ||
| 1136 | |||
| 1137 | (defun nnir-imap-end-of-input () | ||
| 1138 | "Are we at the end of input?" | ||
| 1139 | (skip-chars-forward "[[:blank:]]") | ||
| 1140 | (looking-at "$")) | ||
| 1141 | |||
| 1142 | |||
| 1143 | ;; Swish++ interface. | ||
| 1144 | ;; -cc- Todo | ||
| 1145 | ;; Search by | ||
| 1146 | ;; - group | ||
| 1147 | ;; Sort by | ||
| 1148 | ;; - rank (default) | ||
| 1149 | ;; - article number | ||
| 1150 | ;; - file size | ||
| 1151 | ;; - group | ||
| 1152 | (defun nnir-run-swish++ (query server &optional group) | ||
| 1153 | "Run QUERY against swish++. | ||
| 1154 | Returns a vector of (group name, file name) pairs (also vectors, | ||
| 1155 | actually). | ||
| 1156 | |||
| 1157 | Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on | ||
| 1158 | Windows NT 4.0." | ||
| 1159 | |||
| 1160 | (when group | ||
| 1161 | (error "The swish++ backend cannot search specific groups.")) | ||
| 1162 | |||
| 1163 | (save-excursion | ||
| 1164 | (let ( (qstring (cdr (assq 'query query))) | ||
| 1165 | (groupspec (cdr (assq 'group query))) | ||
| 1166 | (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server)) | ||
| 1167 | artlist | ||
| 1168 | ;; nnml-use-compressed-files might be any string, but probably this | ||
| 1169 | ;; is sufficient. Note that we can't only use the value of | ||
| 1170 | ;; nnml-use-compressed-files because old articles might have been | ||
| 1171 | ;; saved with a different value. | ||
| 1172 | (article-pattern (if (string= server "nnmaildir:") | ||
| 1173 | ":[0-9]+" | ||
| 1174 | "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) | ||
| 1175 | score artno dirnam filenam) | ||
| 1176 | |||
| 1177 | (when (equal "" qstring) | ||
| 1178 | (error "swish++: You didn't enter anything.")) | ||
| 1179 | |||
| 1180 | (set-buffer (get-buffer-create nnir-tmp-buffer)) | ||
| 1181 | (erase-buffer) | ||
| 1182 | |||
| 1183 | (if groupspec | ||
| 1184 | (message "Doing swish++ query %s on %s..." qstring groupspec) | ||
| 1185 | (message "Doing swish++ query %s..." qstring)) | ||
| 1186 | |||
| 1187 | (let* ((cp-list `( ,nnir-swish++-program | ||
| 1188 | nil ; input from /dev/null | ||
| 1189 | t ; output | ||
| 1190 | nil ; don't redisplay | ||
| 1191 | "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server) | ||
| 1192 | ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server) | ||
| 1193 | ,qstring ; the query, in swish++ format | ||
| 1194 | )) | ||
| 1195 | (exitstatus | ||
| 1196 | (progn | ||
| 1197 | (message "%s args: %s" nnir-swish++-program | ||
| 1198 | (mapconcat 'identity (cddddr cp-list) " ")) ;; ??? | ||
| 1199 | (apply 'call-process cp-list)))) | ||
| 1200 | (unless (or (null exitstatus) | ||
| 1201 | (zerop exitstatus)) | ||
| 1202 | (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus) | ||
| 1203 | ;; swish++ failure reason is in this buffer, show it if | ||
| 1204 | ;; the user wants it. | ||
| 1205 | (when (> gnus-verbose 6) | ||
| 1206 | (display-buffer nnir-tmp-buffer)))) | ||
| 1207 | |||
| 1208 | ;; The results are output in the format of: | ||
| 1209 | ;; V 4.7 Linux | ||
| 1210 | ;; rank relative-path-name file-size file-title | ||
| 1211 | ;; V 5.0b2: | ||
| 1212 | ;; rank relative-path-name file-size topic?? | ||
| 1213 | ;; where rank is an integer from 1 to 100. | ||
| 1214 | (goto-char (point-min)) | ||
| 1215 | (while (re-search-forward | ||
| 1216 | "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t) | ||
| 1217 | (setq score (match-string 1) | ||
| 1218 | filenam (match-string 2) | ||
| 1219 | artno (file-name-nondirectory filenam) | ||
| 1220 | dirnam (file-name-directory filenam)) | ||
| 1221 | |||
| 1222 | ;; don't match directories | ||
| 1223 | (when (string-match article-pattern artno) | ||
| 1224 | (when (not (null dirnam)) | ||
| 1225 | |||
| 1226 | ;; maybe limit results to matching groups. | ||
| 1227 | (when (or (not groupspec) | ||
| 1228 | (string-match groupspec dirnam)) | ||
| 1229 | (nnir-add-result dirnam artno score prefix server artlist))))) | ||
| 1230 | |||
| 1231 | (message "Massaging swish++ output...done") | ||
| 1232 | |||
| 1233 | ;; Sort by score | ||
| 1234 | (apply 'vector | ||
| 1235 | (sort* artlist | ||
| 1236 | (function (lambda (x y) | ||
| 1237 | (> (nnir-artitem-rsv x) | ||
| 1238 | (nnir-artitem-rsv y))))))))) | ||
| 1239 | |||
| 1240 | ;; Swish-E interface. | ||
| 1241 | (defun nnir-run-swish-e (query server &optional group) | ||
| 1242 | "Run given query against swish-e. | ||
| 1243 | Returns a vector of (group name, file name) pairs (also vectors, | ||
| 1244 | actually). | ||
| 1245 | |||
| 1246 | Tested with swish-e-2.0.1 on Windows NT 4.0." | ||
| 1247 | |||
| 1248 | ;; swish-e crashes with empty parameter to "-w" on commandline... | ||
| 1249 | (when group | ||
| 1250 | (error "The swish-e backend cannot search specific groups.")) | ||
| 1251 | |||
| 1252 | (save-excursion | ||
| 1253 | (let ((qstring (cdr (assq 'query query))) | ||
| 1254 | (prefix | ||
| 1255 | (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server) | ||
| 1256 | (error "Missing parameter `nnir-swish-e-remove-prefix'"))) | ||
| 1257 | artlist score artno dirnam group ) | ||
| 1258 | |||
| 1259 | (when (equal "" qstring) | ||
| 1260 | (error "swish-e: You didn't enter anything.")) | ||
| 1261 | |||
| 1262 | (set-buffer (get-buffer-create nnir-tmp-buffer)) | ||
| 1263 | (erase-buffer) | ||
| 1264 | |||
| 1265 | (message "Doing swish-e query %s..." query) | ||
| 1266 | (let* ((index-files | ||
| 1267 | (or (nnir-read-server-parm | ||
| 1268 | 'nnir-swish-e-index-files server) | ||
| 1269 | (error "Missing parameter `nnir-swish-e-index-files'"))) | ||
| 1270 | (additional-switches | ||
| 1271 | (nnir-read-server-parm | ||
| 1272 | 'nnir-swish-e-additional-switches server)) | ||
| 1273 | (cp-list `(,nnir-swish-e-program | ||
| 1274 | nil ; input from /dev/null | ||
| 1275 | t ; output | ||
| 1276 | nil ; don't redisplay | ||
| 1277 | "-f" ,@index-files | ||
| 1278 | ,@additional-switches | ||
| 1279 | "-w" | ||
| 1280 | ,qstring ; the query, in swish-e format | ||
| 1281 | )) | ||
| 1282 | (exitstatus | ||
| 1283 | (progn | ||
| 1284 | (message "%s args: %s" nnir-swish-e-program | ||
| 1285 | (mapconcat 'identity (cddddr cp-list) " ")) | ||
| 1286 | (apply 'call-process cp-list)))) | ||
| 1287 | (unless (or (null exitstatus) | ||
| 1288 | (zerop exitstatus)) | ||
| 1289 | (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus) | ||
| 1290 | ;; swish-e failure reason is in this buffer, show it if | ||
| 1291 | ;; the user wants it. | ||
| 1292 | (when (> gnus-verbose 6) | ||
| 1293 | (display-buffer nnir-tmp-buffer)))) | ||
| 1294 | |||
| 1295 | ;; The results are output in the format of: | ||
| 1296 | ;; rank path-name file-title file-size | ||
| 1297 | (goto-char (point-min)) | ||
| 1298 | (while (re-search-forward | ||
| 1299 | "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t) | ||
| 1300 | (setq score (match-string 1) | ||
| 1301 | artno (match-string 3) | ||
| 1302 | dirnam (file-name-directory (match-string 2))) | ||
| 1303 | |||
| 1304 | ;; don't match directories | ||
| 1305 | (when (string-match "^[0-9]+$" artno) | ||
| 1306 | (when (not (null dirnam)) | ||
| 1307 | |||
| 1308 | ;; remove nnir-swish-e-remove-prefix from beginning of dirname | ||
| 1309 | (when (string-match (concat "^" prefix) dirnam) | ||
| 1310 | (setq dirnam (replace-match "" t t dirnam))) | ||
| 1311 | |||
| 1312 | (setq dirnam (substring dirnam 0 -1)) | ||
| 1313 | ;; eliminate all ".", "/", "\" from beginning. Always matches. | ||
| 1314 | (string-match "^[./\\]*\\(.*\\)$" dirnam) | ||
| 1315 | ;; "/" -> "." | ||
| 1316 | (setq group (substitute ?. ?/ (match-string 1 dirnam))) | ||
| 1317 | ;; Windows "\\" -> "." | ||
| 1318 | (setq group (substitute ?. ?\\ group)) | ||
| 1319 | |||
| 1320 | (push (vector (nnir-group-full-name group server) | ||
| 1321 | (string-to-number artno) | ||
| 1322 | (string-to-number score)) | ||
| 1323 | artlist)))) | ||
| 1324 | |||
| 1325 | (message "Massaging swish-e output...done") | ||
| 1326 | |||
| 1327 | ;; Sort by score | ||
| 1328 | (apply 'vector | ||
| 1329 | (sort* artlist | ||
| 1330 | (function (lambda (x y) | ||
| 1331 | (> (nnir-artitem-rsv x) | ||
| 1332 | (nnir-artitem-rsv y))))))))) | ||
| 1333 | |||
| 1334 | ;; HyREX interface | ||
| 1335 | (defun nnir-run-hyrex (query server &optional group) | ||
| 1336 | (save-excursion | ||
| 1337 | (let ((artlist nil) | ||
| 1338 | (groupspec (cdr (assq 'group query))) | ||
| 1339 | (qstring (cdr (assq 'query query))) | ||
| 1340 | (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server)) | ||
| 1341 | score artno dirnam) | ||
| 1342 | (when (and group groupspec) | ||
| 1343 | (error (concat "It does not make sense to use a group spec" | ||
| 1344 | " with process-marked groups."))) | ||
| 1345 | (when group | ||
| 1346 | (setq groupspec (gnus-group-real-name group))) | ||
| 1347 | (when (and group (not (equal group (nnir-group-full-name groupspec server)))) | ||
| 1348 | (message "%s vs. %s" group (nnir-group-full-name groupspec server)) | ||
| 1349 | (error "Server with groupspec doesn't match group !")) | ||
| 1350 | (set-buffer (get-buffer-create nnir-tmp-buffer)) | ||
| 1351 | (erase-buffer) | ||
| 1352 | (if groupspec | ||
| 1353 | (message "Doing hyrex-search query %s on %s..." query groupspec) | ||
| 1354 | (message "Doing hyrex-search query %s..." query)) | ||
| 1355 | (let* ((cp-list | ||
| 1356 | `( ,nnir-hyrex-program | ||
| 1357 | nil ; input from /dev/null | ||
| 1358 | t ; output | ||
| 1359 | nil ; don't redisplay | ||
| 1360 | "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory | ||
| 1361 | ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server) | ||
| 1362 | ,qstring ; the query, in hyrex-search format | ||
| 1363 | )) | ||
| 1364 | (exitstatus | ||
| 1365 | (progn | ||
| 1366 | (message "%s args: %s" nnir-hyrex-program | ||
| 1367 | (mapconcat 'identity (cddddr cp-list) " ")) | ||
| 1368 | (apply 'call-process cp-list)))) | ||
| 1369 | (unless (or (null exitstatus) | ||
| 1370 | (zerop exitstatus)) | ||
| 1371 | (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus) | ||
| 1372 | ;; nnir-search failure reason is in this buffer, show it if | ||
| 1373 | ;; the user wants it. | ||
| 1374 | (when (> gnus-verbose 6) | ||
| 1375 | (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer ! | ||
| 1376 | (if groupspec | ||
| 1377 | (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec) | ||
| 1378 | (message "Doing hyrex-search query \"%s\"...done" qstring)) | ||
| 1379 | (sit-for 0) | ||
| 1380 | ;; nnir-search returns: | ||
| 1381 | ;; for nnml/nnfolder: "filename mailid weigth" | ||
| 1382 | ;; for nnimap: "group mailid weigth" | ||
| 1383 | (goto-char (point-min)) | ||
| 1384 | (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") | ||
| 1385 | ;; HyREX couldn't search directly in groups -- so filter out here. | ||
| 1386 | (when groupspec | ||
| 1387 | (keep-lines groupspec)) | ||
| 1388 | ;; extract data from result lines | ||
| 1389 | (goto-char (point-min)) | ||
| 1390 | (while (re-search-forward | ||
| 1391 | "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t) | ||
| 1392 | (setq dirnam (match-string 1) | ||
| 1393 | artno (match-string 2) | ||
| 1394 | score (match-string 3)) | ||
| 1395 | (when (string-match prefix dirnam) | ||
| 1396 | (setq dirnam (replace-match "" t t dirnam))) | ||
| 1397 | (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server) | ||
| 1398 | (string-to-number artno) | ||
| 1399 | (string-to-number score)) | ||
| 1400 | artlist)) | ||
| 1401 | (message "Massaging hyrex-search output...done.") | ||
| 1402 | (apply 'vector | ||
| 1403 | (sort* artlist | ||
| 1404 | (function (lambda (x y) | ||
| 1405 | (if (string-lessp (nnir-artitem-group x) | ||
| 1406 | (nnir-artitem-group y)) | ||
| 1407 | t | ||
| 1408 | (< (nnir-artitem-number x) | ||
| 1409 | (nnir-artitem-number y))))))) | ||
| 1410 | ))) | ||
| 1411 | |||
| 1412 | ;; Namazu interface | ||
| 1413 | (defun nnir-run-namazu (query server &optional group) | ||
| 1414 | "Run given query against Namazu. Returns a vector of (group name, file name) | ||
| 1415 | pairs (also vectors, actually). | ||
| 1416 | |||
| 1417 | Tested with Namazu 2.0.6 on a GNU/Linux system." | ||
| 1418 | (when group | ||
| 1419 | (error "The Namazu backend cannot search specific groups")) | ||
| 1420 | (save-excursion | ||
| 1421 | (let ((article-pattern (if (string= server "nnmaildir:") | ||
| 1422 | ":[0-9]+" | ||
| 1423 | "^[0-9]+$")) | ||
| 1424 | artlist | ||
| 1425 | (qstring (cdr (assq 'query query))) | ||
| 1426 | (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server)) | ||
| 1427 | score group article | ||
| 1428 | (process-environment (copy-sequence process-environment))) | ||
| 1429 | (setenv "LC_MESSAGES" "C") | ||
| 1430 | (set-buffer (get-buffer-create nnir-tmp-buffer)) | ||
| 1431 | (erase-buffer) | ||
| 1432 | (let* ((cp-list | ||
| 1433 | `( ,nnir-namazu-program | ||
| 1434 | nil ; input from /dev/null | ||
| 1435 | t ; output | ||
| 1436 | nil ; don't redisplay | ||
| 1437 | "-q" ; don't be verbose | ||
| 1438 | "-a" ; show all matches | ||
| 1439 | "-s" ; use short format | ||
| 1440 | ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server) | ||
| 1441 | ,qstring ; the query, in namazu format | ||
| 1442 | ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory | ||
| 1443 | )) | ||
| 1444 | (exitstatus | ||
| 1445 | (progn | ||
| 1446 | (message "%s args: %s" nnir-namazu-program | ||
| 1447 | (mapconcat 'identity (cddddr cp-list) " ")) | ||
| 1448 | (apply 'call-process cp-list)))) | ||
| 1449 | (unless (or (null exitstatus) | ||
| 1450 | (zerop exitstatus)) | ||
| 1451 | (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus) | ||
| 1452 | ;; Namazu failure reason is in this buffer, show it if | ||
| 1453 | ;; the user wants it. | ||
| 1454 | (when (> gnus-verbose 6) | ||
| 1455 | (display-buffer nnir-tmp-buffer)))) | ||
| 1456 | |||
| 1457 | ;; Namazu output looks something like this: | ||
| 1458 | ;; 2. Re: Gnus agent expire broken (score: 55) | ||
| 1459 | ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes) | ||
| 1460 | |||
| 1461 | (goto-char (point-min)) | ||
| 1462 | (while (re-search-forward | ||
| 1463 | "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)" | ||
| 1464 | nil t) | ||
| 1465 | (setq score (match-string 3) | ||
| 1466 | group (file-name-directory (match-string 4)) | ||
| 1467 | article (file-name-nondirectory (match-string 4))) | ||
| 1468 | |||
| 1469 | ;; make sure article and group is sane | ||
| 1470 | (when (and (string-match article-pattern article) | ||
| 1471 | (not (null group))) | ||
| 1472 | (nnir-add-result group article score prefix server artlist))) | ||
| 1473 | |||
| 1474 | ;; sort artlist by score | ||
| 1475 | (apply 'vector | ||
| 1476 | (sort* artlist | ||
| 1477 | (function (lambda (x y) | ||
| 1478 | (> (nnir-artitem-rsv x) | ||
| 1479 | (nnir-artitem-rsv y))))))))) | ||
| 1480 | |||
| 1481 | (defun nnir-run-find-grep (query server &optional group) | ||
| 1482 | "Run find and grep to obtain matching articles." | ||
| 1483 | (let* ((method (gnus-server-to-method server)) | ||
| 1484 | (sym (intern | ||
| 1485 | (concat (symbol-name (car method)) "-directory"))) | ||
| 1486 | (directory (cadr (assoc sym (cddr method)))) | ||
| 1487 | (regexp (cdr (assoc 'query query))) | ||
| 1488 | (grep-options (cdr (assoc 'grep-options query))) | ||
| 1489 | artlist) | ||
| 1490 | (unless directory | ||
| 1491 | (error "No directory found in method specification of server %s" | ||
| 1492 | server)) | ||
| 1493 | (message "Searching %s using find-grep..." (or group server)) | ||
| 1494 | (save-window-excursion | ||
| 1495 | (set-buffer (get-buffer-create nnir-tmp-buffer)) | ||
| 1496 | (erase-buffer) | ||
| 1497 | (if (> gnus-verbose 6) | ||
| 1498 | (pop-to-buffer (current-buffer))) | ||
| 1499 | (cd directory) ; Using relative paths simplifies postprocessing. | ||
| 1500 | (let ((group | ||
| 1501 | (if (not group) | ||
| 1502 | "." | ||
| 1503 | ;; Try accessing the group literally as well as | ||
| 1504 | ;; interpreting dots as directory separators so the | ||
| 1505 | ;; engine works with plain nnml as well as the Gnus | ||
| 1506 | ;; Cache. | ||
| 1507 | (find-if 'file-directory-p | ||
| 1508 | (let ((group (gnus-group-real-name group))) | ||
| 1509 | (list group (gnus-replace-in-string group "\\." "/" t))))))) | ||
| 1510 | (unless group | ||
| 1511 | (error "Cannot locate directory for group")) | ||
| 1512 | (save-excursion | ||
| 1513 | (apply | ||
| 1514 | 'call-process "find" nil t | ||
| 1515 | "find" group "-type" "f" "-name" "[0-9]*" "-exec" | ||
| 1516 | "grep" | ||
| 1517 | `("-l" ,@(and grep-options (split-string grep-options "\\s-" t)) | ||
| 1518 | "-e" ,regexp "{}" "+")))) | ||
| 1519 | |||
| 1520 | ;; Translate relative paths to group names. | ||
| 1521 | (while (not (eobp)) | ||
| 1522 | (let* ((path (split-string | ||
| 1523 | (buffer-substring (point) (line-end-position)) "/" t)) | ||
| 1524 | (art (string-to-number (car (last path))))) | ||
| 1525 | (while (string= "." (car path)) | ||
| 1526 | (setq path (cdr path))) | ||
| 1527 | (let ((group (mapconcat 'identity (subseq path 0 -1) "."))) | ||
| 1528 | (push (vector (nnir-group-full-name group server) art 0) | ||
| 1529 | artlist)) | ||
| 1530 | (forward-line 1))) | ||
| 1531 | (message "Searching %s using find-grep...done" (or group server)) | ||
| 1532 | artlist))) | ||
| 1533 | |||
| 1534 | ;;; Util Code: | ||
| 1535 | |||
| 1536 | (defun nnir-read-parms (query) | ||
| 1537 | "Reads additional search parameters according to `nnir-engines'." | ||
| 1538 | (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines)))) | ||
| 1539 | (cons (cons 'query query) | ||
| 1540 | (mapcar 'nnir-read-parm parmspec)))) | ||
| 1541 | |||
| 1542 | (defun nnir-read-parm (parmspec) | ||
| 1543 | "Reads a single search parameter. | ||
| 1544 | `parmspec' is a cons cell, the car is a symbol, the cdr is a prompt." | ||
| 1545 | (let ((sym (car parmspec)) | ||
| 1546 | (prompt (cdr parmspec))) | ||
| 1547 | (if (listp prompt) | ||
| 1548 | (let* ((result (apply 'completing-read prompt)) | ||
| 1549 | (mapping (or (assoc result nnir-imap-search-arguments) | ||
| 1550 | (assoc nil nnir-imap-search-arguments)))) | ||
| 1551 | (cons sym (format (cdr mapping) result))) | ||
| 1552 | (cons sym (read-string prompt))))) | ||
| 1553 | |||
| 1554 | (defun nnir-run-query (query) | ||
| 1555 | "Invoke appropriate search engine function (see `nnir-engines'). | ||
| 1556 | If some groups were process-marked, run the query for each of the groups | ||
| 1557 | and concat the results." | ||
| 1558 | (let ((q (car (read-from-string query)))) | ||
| 1559 | (if gnus-group-marked | ||
| 1560 | (apply 'vconcat | ||
| 1561 | (mapcar (lambda (x) | ||
| 1562 | (let ((server (nnir-group-server x)) | ||
| 1563 | search-func) | ||
| 1564 | (setq search-func (cadr | ||
| 1565 | (assoc | ||
| 1566 | (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) | ||
| 1567 | (if search-func | ||
| 1568 | (funcall search-func q server x) | ||
| 1569 | nil))) | ||
| 1570 | gnus-group-marked) | ||
| 1571 | ) | ||
| 1572 | (apply 'vconcat | ||
| 1573 | (mapcar (lambda (x) | ||
| 1574 | (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral"))) | ||
| 1575 | (let ((server (format "%s:%s" (caar x) (cadar x))) | ||
| 1576 | search-func) | ||
| 1577 | (setq search-func (cadr | ||
| 1578 | (assoc | ||
| 1579 | (nnir-read-server-parm 'nnir-search-engine server) nnir-engines))) | ||
| 1580 | (if search-func | ||
| 1581 | (funcall search-func q server nil) | ||
| 1582 | nil)) | ||
| 1583 | nil)) | ||
| 1584 | gnus-opened-servers) | ||
| 1585 | )) | ||
| 1586 | )) | ||
| 1587 | |||
| 1588 | (defun nnir-read-server-parm (key server) | ||
| 1589 | "Returns the parameter value of for the given server, where server is of | ||
| 1590 | form 'backend:name'." | ||
| 1591 | (let ((method (gnus-server-to-method server))) | ||
| 1592 | (cond ((and method (assq key (cddr method))) | ||
| 1593 | (nth 1 (assq key (cddr method)))) | ||
| 1594 | ((and nnir-mail-backend | ||
| 1595 | (gnus-server-equal method nnir-mail-backend)) | ||
| 1596 | (symbol-value key)) | ||
| 1597 | (t nil)))) | ||
| 1598 | ;; (if method | ||
| 1599 | ;; (if (assq key (cddr method)) | ||
| 1600 | ;; (nth 1 (assq key (cddr method))) | ||
| 1601 | ;; (symbol-value key)) | ||
| 1602 | ;; (symbol-value key)) | ||
| 1603 | ;; )) | ||
| 1604 | |||
| 1605 | (defun nnir-group-full-name (shortname server) | ||
| 1606 | "For the given group name, return a full Gnus group name. | ||
| 1607 | The Gnus backend/server information is added." | ||
| 1608 | (gnus-group-prefixed-name shortname (gnus-server-to-method server))) | ||
| 1609 | |||
| 1610 | (defun nnir-possibly-change-server (server) | ||
| 1611 | (unless (and server (nnir-server-opened server)) | ||
| 1612 | (nnir-open-server server))) | ||
| 1613 | |||
| 1614 | |||
| 1615 | ;; Data type article list. | ||
| 1616 | |||
| 1617 | (defun nnir-artlist-length (artlist) | ||
| 1618 | "Returns number of articles in artlist." | ||
| 1619 | (length artlist)) | ||
| 1620 | |||
| 1621 | (defun nnir-artlist-article (artlist n) | ||
| 1622 | "Returns from ARTLIST the Nth artitem (counting starting at 1)." | ||
| 1623 | (elt artlist (1- n))) | ||
| 1624 | |||
| 1625 | (defun nnir-artitem-group (artitem) | ||
| 1626 | "Returns the group from the ARTITEM." | ||
| 1627 | (elt artitem 0)) | ||
| 1628 | |||
| 1629 | (defun nnir-artlist-artitem-group (artlist n) | ||
| 1630 | "Returns from ARTLIST the group of the Nth artitem (counting from 1)." | ||
| 1631 | (nnir-artitem-group (nnir-artlist-article artlist n))) | ||
| 1632 | |||
| 1633 | (defun nnir-artitem-number (artitem) | ||
| 1634 | "Returns the number from the ARTITEM." | ||
| 1635 | (elt artitem 1)) | ||
| 1636 | |||
| 1637 | (defun nnir-artlist-artitem-number (artlist n) | ||
| 1638 | "Returns from ARTLIST the number of the Nth artitem (counting from 1)." | ||
| 1639 | (nnir-artitem-number (nnir-artlist-article artlist n))) | ||
| 1640 | |||
| 1641 | (defun nnir-artitem-rsv (artitem) | ||
| 1642 | "Returns the Retrieval Status Value (RSV, score) from the ARTITEM." | ||
| 1643 | (elt artitem 2)) | ||
| 1644 | |||
| 1645 | (defun nnir-artlist-artitem-rsv (artlist n) | ||
| 1646 | "Returns from ARTLIST the Retrieval Status Value of the Nth artitem | ||
| 1647 | \(counting from 1)." | ||
| 1648 | (nnir-artitem-rsv (nnir-artlist-article artlist n))) | ||
| 1649 | |||
| 1650 | ;; unused? | ||
| 1651 | (defun nnir-artlist-groups (artlist) | ||
| 1652 | "Returns a list of all groups in the given ARTLIST." | ||
| 1653 | (let ((res nil) | ||
| 1654 | (with-dups nil)) | ||
| 1655 | ;; from each artitem, extract group component | ||
| 1656 | (setq with-dups (mapcar 'nnir-artitem-group artlist)) | ||
| 1657 | ;; remove duplicates from above | ||
| 1658 | (mapc (function (lambda (x) (add-to-list 'res x))) | ||
| 1659 | with-dups) | ||
| 1660 | res)) | ||
| 1661 | |||
| 1662 | |||
| 1663 | ;; The end. | ||
| 1664 | (provide 'nnir) | ||
| 1665 | |||
| 1666 | ;;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 | ||