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