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