gnus-group.el (gnus-read-ephemeral-emacs-bug-group): Take an optional quit window...

[bpt/emacs.git] / lisp / gnus / nnir.el

diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 0fc0077..f1a97dc 100644 (file)
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -1,7 +1,6 @@
 ;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
 
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
-;;   2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
 
 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
 ;; Swish-e and Swish++ backends by:
@@ -204,11 +203,12 @@
 ;; Imap variables
 
 (defvar nnir-imap-search-arguments
-  '(("Whole message" . "TEXT")
-    ("Subject" . "SUBJECT")
-    ("To" . "TO")
-    ("From" . "FROM")
-    ("Imap" . ""))
+  '(("whole message" . "TEXT")
+    ("subject" . "SUBJECT")
+    ("to" . "TO")
+    ("from" . "FROM")
+    ("body" . "BODY")
+    ("imap" . ""))
   "Mapping from user readable keys to IMAP search items for use in nnir")
 
 (defvar nnir-imap-search-other "HEADER %S"
@@ -336,7 +336,7 @@ result, `gnus-retrieve-headers' will be called instead."
   :type '(function)
   :group 'nnir)
 
-(defcustom nnir-imap-default-search-key "Whole message"
+(defcustom nnir-imap-default-search-key "whole message"
   "*The default IMAP search key for an nnir search. Must be one of
   the keys in `nnir-imap-search-arguments'. To use raw imap queries
   by default set this to \"Imap\"."
@@ -657,22 +657,39 @@ Add an entry here when adding a new search engine.")
       'nov)))
 
 (deffoo nnir-request-article (article &optional group server to-buffer)
-  (if (stringp article)
+  (if (and (stringp article)
+          (not (eq 'nnimap (car (gnus-server-to-method server)))))
       (nnheader-report
        'nnir
-       "nnir-retrieve-headers doesn't grok message ids: %s"
-       article)
+       "nnir-retrieve-headers only groks message ids for nnimap servers: %s"
+       server)
     (save-excursion
-      (let ((artfullgroup (nnir-article-group article))
-           (artno (nnir-article-number article)))
-       (message "Requesting article %d from group %s"
-                artno artfullgroup)
-       (if to-buffer
-           (with-current-buffer to-buffer
-             (let ((gnus-article-decode-hook nil))
-               (gnus-request-article-this-buffer artno artfullgroup)))
-         (gnus-request-article artno artfullgroup))
-       (cons artfullgroup artno)))))
+      (let ((article article)
+           query)
+       (when (stringp article)
+         (setq gnus-override-method (gnus-server-to-method server))
+         (setq query
+               (list
+                (cons 'query (format "HEADER Message-ID %s" article))
+                (cons 'unique-id article)
+                (cons 'criteria "")))
+         (unless (and (equal query nnir-current-query)
+                      (equal server nnir-current-server))
+           (setq nnir-artlist (nnir-run-imap query server))
+           (setq nnir-current-query query)
+           (setq nnir-current-server server))
+         (setq article 1))
+       (unless (zerop (length nnir-artlist))
+         (let ((artfullgroup (nnir-article-group article))
+               (artno (nnir-article-number article)))
+           (message "Requesting article %d from group %s"
+                    artno artfullgroup)
+           (if to-buffer
+               (with-current-buffer to-buffer
+                 (let ((gnus-article-decode-hook nil))
+                   (gnus-request-article-this-buffer artno artfullgroup)))
+             (gnus-request-article artno artfullgroup))
+           (cons artfullgroup artno)))))))
 
 (deffoo nnir-request-move-article (article group server accept-form
                                           &optional last internal-move-group)
@@ -1501,11 +1518,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
                (setq search-func (cadr (assoc nnir-search-engine
                                               nnir-engines)))
                (if search-func
-                   (funcall search-func
-                            (if nnir-extra-parms
-                                (nnir-read-parms q nnir-search-engine)
-                              q)
-                            server (cadr x))
+                   (funcall
+                    search-func
+                    (if nnir-extra-parms
+                        (or (and (eq nnir-search-engine 'imap)
+                                 (assq 'criteria q) q)
+                            (setq q (nnir-read-parms q nnir-search-engine)))
+                      q)
+                    server (cadr x))
                  nil)))
            groups))))