(with-auth-source-epa-overrides): Fix compilation error with `find-file-hooks' on...
[gnus] / lisp / nnir.el
index d3ec3d2..eaaac3f 100644 (file)
@@ -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 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:
 ;; 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"
@@ -289,7 +289,9 @@ is `(valuefunc member)'."
   (autoload 'nnimap-buffer "nnimap")
   (autoload 'nnimap-command "nnimap")
   (autoload 'nnimap-possibly-change-group "nnimap")
-  (autoload 'gnus-registry-action "gnus-registry"))
+  (autoload 'gnus-registry-action "gnus-registry")
+  (defvar gnus-registry-install))
+
 
 (nnoo-declare nnir)
 (nnoo-define-basics nnir)
@@ -303,13 +305,6 @@ is `(valuefunc member)'."
   "Search groups in Gnus with assorted seach engines."
   :group 'gnus)
 
-(defcustom nnir-method-default-engines
-  '((nnimap . imap)
-    (nntp . gmane))
-  "*Alist of default search engines keyed by server method."
-  :type '(alist)
-  :group 'nnir)
-
 (defcustom nnir-ignored-newsgroups ""
   "*A regexp to match newsgroups in the active file that should
   be skipped when searching."
@@ -327,7 +322,7 @@ with three items unique to nnir summary buffers:
 %g    Article original short group name (string)
 
 If nil this will use `gnus-summary-line-format'."
-  :type '(regexp)
+  :type '(string)
   :group 'nnir)
 
 (defcustom nnir-retrieve-headers-override-function nil
@@ -341,11 +336,12 @@ 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\"."
-  :type '(string)
+  :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
+                          nnir-imap-search-arguments))
   :group 'nnir)
 
 (defcustom nnir-swish++-configuration-file
@@ -544,6 +540,18 @@ needs the variables `nnir-namazu-program',
 
 Add an entry here when adding a new search engine.")
 
+(defcustom nnir-method-default-engines
+  '((nnimap . imap)
+    (nntp . gmane))
+  "*Alist of default search engines keyed by server method."
+  :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool)
+                              (const nneething) (const nndir) (const nnmbox)
+                              (const nnml) (const nnmh) (const nndraft)
+                              (const nnfolder) (const nnmaildir))
+                      (choice
+                       ,@(mapcar (lambda (elem) (list 'const (car elem)))
+                                 nnir-engines))))
+  :group 'nnir)
 
 ;; Gnus glue.
 
@@ -1397,14 +1405,15 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
 ;; gmane interface
 (defun nnir-run-gmane (query srv &optional groups)
   "Run a search against a gmane back-end server."
-  (if (gnus-string-match-p  "gmane" srv)
       (let* ((case-fold-search t)
             (qstring (cdr (assq 'query query)))
             (server (cadr (gnus-server-to-method srv)))
             (groupspec (mapconcat
                         (lambda (x)
-                          (format "group:%s" (gnus-group-short-name x)))
-                        groups " "))
+                          (if (gnus-string-match-p "gmane" x)
+                              (format "group:%s" (gnus-group-short-name x))
+                            (error "Can't search non-gmane groups: %s" x)))
+                          groups " "))
             (authorspec
              (if (assq 'author query)
                  (format "author:%s" (cdr (assq 'author query))) ""))
@@ -1439,9 +1448,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
                      (string-to-number (match-string 2 xref)) xscore)
                     artlist)))))
            (forward-line 1)))
-       (apply 'vector (nreverse (mm-delete-duplicates artlist))))
-    (message "Can't search non-gmane nntp groups")
-    nil))
+       (apply 'vector (nreverse (mm-delete-duplicates artlist)))))
 
 ;;; Util Code:
 
@@ -1494,11 +1501,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))))
 
@@ -1536,7 +1546,8 @@ server is of form 'backend:name'."
       (let ((cur (current-buffer))
            name)
        (goto-char (point-min))
-       (unless (string= nnir-ignored-newsgroups "")
+       (unless (or (null nnir-ignored-newsgroups)
+                   (string= nnir-ignored-newsgroups ""))
          (delete-matching-lines nnir-ignored-newsgroups))
        (if (eq (car method) 'nntp)
            (while (not (eobp))
@@ -1582,12 +1593,14 @@ server is of form 'backend:name'."
   (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir)
     (setq gnus-summary-line-format
          (or nnir-summary-line-format gnus-summary-line-format))
-    (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
-    (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
-    (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t)
-    (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
-    (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)
-    (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t)))
+    (when (and (boundp 'gnus-registry-install)
+                      (eq gnus-registry-install t))
+      (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t)
+      (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t)
+      (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t)
+      (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
+      (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t)
+      (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))))