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