Store the IMAP greeting, so that we can tell what kind of server we're talking to.

[gnus] / lisp / nnir.el

diff --git a/lisp/nnir.el b/lisp/nnir.el
index 452e67c..db8b397 100644 (file)
--- a/lisp/nnir.el
+++ b/lisp/nnir.el
@@ -1,7 +1,7 @@
 ;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
 ;;; 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 Free Software Foundation, Inc.
+;;   2007, 2008, 2009, 2010 Free Software Foundation, Inc.

 
 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
 ;; Swish-e and Swish++ backends by:
 
 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
 ;; Swish-e and Swish++ backends by:


@@ -52,7 +52,7 @@
 
 
 ;; The most recent version of this can always be fetched from the Gnus
 
 
 ;; The most recent version of this can always be fetched from the Gnus

-;; CVS repository.  See http://www.gnus.org/ for more information.
+;; repository.  See http://www.gnus.org/ for more information.

 
 ;; This code is still in the development stage but I'd like other
 ;; people to have a look at it.  Please do not hesitate to contact me
 
 ;; This code is still in the development stage but I'd like other
 ;; people to have a look at it.  Please do not hesitate to contact me


@@ -263,10 +263,10 @@
 
 ;; I have tried to make the code expandable.  Basically, it is divided
 ;; into two layers.  The upper layer is somewhat like the `nnvirtual'
 
 ;; I have tried to make the code expandable.  Basically, it is divided
 ;; into two layers.  The upper layer is somewhat like the `nnvirtual'

-;; or `nnkiboze' backends: given a specification of what articles to
-;; show from another backend, it creates a group containing exactly
-;; those articles.  The lower layer issues a query to a search engine
-;; and produces such a specification of what articles to show from the
+;; backend: given a specification of what articles to show from
+;; another backend, it creates a group containing exactly those
+;; articles.  The lower layer issues a query to a search engine and
+;; produces such a specification of what articles to show from the

 ;; other backend.
 
 ;; The interface between the two layers consists of the single
 ;; other backend.
 
 ;; The interface between the two layers consists of the single


@@ -345,19 +345,29 @@
 (gnus-declare-backend "nnir" 'mail)
 
 (defvar nnir-imap-search-field "TEXT"
 (gnus-declare-backend "nnir" 'mail)
 
 (defvar nnir-imap-search-field "TEXT"

-  "The IMAP search item when doing an nnir search")
+  "The IMAP search item when doing an nnir search. To use raw
+  imap queries by default set this to \"\"")

 
 (defvar nnir-imap-search-arguments
   '(("Whole message" . "TEXT")
     ("Subject" . "SUBJECT")
     ("To" . "TO")
     ("From" . "FROM")
 
 (defvar nnir-imap-search-arguments
   '(("Whole message" . "TEXT")
     ("Subject" . "SUBJECT")
     ("To" . "TO")
     ("From" . "FROM")

-    (nil . "HEADER \"%s\""))
+    ("Head" . "HEADER \"%s\"")
+    (nil . ""))

   "Mapping from user readable strings to IMAP search items for use in nnir")
 
 (defvar nnir-imap-search-argument-history ()
   "The history for querying search options in nnir")
 
   "Mapping from user readable strings to IMAP search items for use in nnir")
 
 (defvar nnir-imap-search-argument-history ()
   "The history for querying search options in nnir")
 

+(defvar nnir-get-article-nov-override-function nil
+  "If non-nil, a function that will be passed each search result.  This
+should return a message's headers in NOV format.
+
+If this variable is nil, or if the provided function returns nil for a search
+result, `gnus-retrieve-headers' will be called instead.")
+
+

 ;;; Developer Extension Variable:
 
 (defvar nnir-engines
 ;;; Developer Extension Variable:
 
 (defvar nnir-engines


@@ -690,7 +700,7 @@ The returned format is as `gnus-server-to-method' needs it.  See
 and show thread that contains this article."
   (interactive)
   (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
 and show thread that contains this article."
   (interactive)
   (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))

-    (error "Can't execute this command unless in nnir group."))
+    (error "Can't execute this command unless in nnir group"))

   (let* ((cur (gnus-summary-article-number))
          (group (nnir-artlist-artitem-group nnir-artlist cur))
          (backend-number (nnir-artlist-artitem-number nnir-artlist cur))
   (let* ((cur (gnus-summary-article-number))
          (group (nnir-artlist-artitem-group nnir-artlist cur))
          (backend-number (nnir-artlist-artitem-number nnir-artlist cur))


@@ -725,7 +735,7 @@ and show thread that contains this article."
   ;; Just set the server variables appropriately.
   (nnoo-change-server 'nnir server definitions))
 
   ;; Just set the server variables appropriately.
   (nnoo-change-server 'nnir server definitions))
 

-(deffoo nnir-request-group (group &optional server fast)
+(deffoo nnir-request-group (group &optional server fast info)

   "GROUP is the query string."
   (nnir-possibly-change-server server)
   ;; Check for cache and return that if appropriate.
   "GROUP is the query string."
   (nnir-possibly-change-server server)
   ;; Check for cache and return that if appropriate.


@@ -736,8 +746,7 @@ and show thread that contains this article."
       nnir-artlist
     ;; Cache miss.
     (setq nnir-artlist (nnir-run-query group)))
       nnir-artlist
     ;; Cache miss.
     (setq nnir-artlist (nnir-run-query group)))

-  (save-excursion
-    (set-buffer nntp-server-buffer)
+  (with-current-buffer nntp-server-buffer

     (if (zerop (length nnir-artlist))
        (progn
          (setq nnir-current-query nil
     (if (zerop (length nnir-artlist))
        (progn
          (setq nnir-current-query nil


@@ -779,25 +788,31 @@ and show thread that contains this article."
        (nnir-possibly-change-server server)
         (let ((gnus-override-method
               (gnus-server-to-method server)))
        (nnir-possibly-change-server server)
         (let ((gnus-override-method
               (gnus-server-to-method server)))

-         (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil))
-           (nov
-            (goto-char (point-min))
-            (setq novitem (nnheader-parse-nov))
-            (unless novitem
-              (pop-to-buffer nntp-server-buffer)
-              (error
-               "nnheader-parse-nov returned nil for article %s in group %s"
-               artno artfullgroup)))
-           (headers
-            (goto-char (point-min))
-            (setq novitem (nnheader-parse-head))
-            (unless novitem
-              (pop-to-buffer nntp-server-buffer)
-              (error
-               "nnheader-parse-head returned nil for article %s in group %s"
-               artno artfullgroup)))
-           (t (error "Unknown header type %s while requesting article %s of group %s"
-                     foo artno artfullgroup))))
+         ;; if nnir-get-article-nov-override-function is set, use it
+         (if nnir-get-article-nov-override-function
+             (setq novitem (funcall nnir-get-article-nov-override-function
+                                    artitem))
+         ;; else, set novitem through nnheader-parse-nov/nnheader-parse-head
+           (case (setq foo (gnus-retrieve-headers (list artno)
+                                                  artfullgroup nil))
+             (nov
+              (goto-char (point-min))
+              (setq novitem (nnheader-parse-nov))
+              (unless novitem
+                (pop-to-buffer nntp-server-buffer)
+                (error
+                 "nnheader-parse-nov returned nil for article %s in group %s"
+                 artno artfullgroup)))
+             (headers
+              (goto-char (point-min))
+              (setq novitem (nnheader-parse-head))
+              (unless novitem
+                (pop-to-buffer nntp-server-buffer)
+                (error
+                 "nnheader-parse-head returned nil for article %s in group %s"
+                 artno artfullgroup)))
+             (t (error "Unknown header type %s while requesting article %s of group %s"
+                       foo artno artfullgroup)))))

        ;; replace article number in original group with article number
         ;; in nnir group
         (mail-header-set-number novitem art)
        ;; replace article number in original group with article number
         ;; in nnir group
         (mail-header-set-number novitem art)


@@ -889,7 +904,7 @@ ready to be added to the list of search results."
   "Run given query agains waissearch.  Returns vector of (group name, file name)
 pairs (also vectors, actually)."
   (when group
   "Run given query agains waissearch.  Returns vector of (group name, file name)
 pairs (also vectors, actually)."
   (when group

-    (error "The freeWAIS-sf backend cannot search specific groups."))
+    (error "The freeWAIS-sf backend cannot search specific groups"))

   (save-excursion
     (let ((qstring (cdr (assq 'query query)))
          (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server))
   (save-excursion
     (let ((qstring (cdr (assq 'query query)))
          (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server))


@@ -943,6 +958,11 @@ pairs (also vectors, actually)."
 (autoload 'imap-search "imap")
 (autoload 'imap-quote-specials "imap")
 
 (autoload 'imap-search "imap")
 (autoload 'imap-quote-specials "imap")
 

+(eval-when-compile
+  (autoload 'nnimap-buffer "nnimap")
+  (autoload 'nnimap-command "nnimap")
+  (autoload 'nnimap-possibly-change-group "nnimap"))
+

 (defun nnir-run-imap (query srv &optional group-option)
   "Run a search against an IMAP back-end server.
 This uses a custom query language parser; see `nnir-imap-make-query' for
 (defun nnir-run-imap (query srv &optional group-option)
   "Run a search against an IMAP back-end server.
 This uses a custom query language parser; see `nnir-imap-make-query' for


@@ -954,23 +974,30 @@ details on the language and supported extensions"
          (defs (caddr (gnus-server-to-method srv)))
          (criteria (or (cdr (assq 'criteria query))
                        nnir-imap-search-field))
          (defs (caddr (gnus-server-to-method srv)))
          (criteria (or (cdr (assq 'criteria query))
                        nnir-imap-search-field))

-         artlist buf)
+         (gnus-inhibit-demon t)
+         artlist)

       (message "Opening server %s" server)
       (condition-case ()
       (message "Opening server %s" server)
       (condition-case ()

-         (when (nnimap-open-server server defs) ;; xxx
-           (setq buf nnimap-server-buffer) ;; xxx
-           (message "Searching %s..." group)
-            (let ((arts 0)
-                  (mbx (gnus-group-real-name group)))
-              (when (imap-mailbox-select mbx nil buf)
-                (mapc
-                 (lambda (artnum)
-                   (push (vector group artnum 1) artlist)
-                   (setq arts (1+ arts)))
-                 (imap-search (nnir-imap-make-query criteria qstring) buf))
-                (message "Searching %s... %d matches" mbx arts)))
-            (message "Searching %s...done" group))
-        (quit nil))
+         (when (nnimap-possibly-change-group (gnus-group-short-name group) server)
+           (with-current-buffer (nnimap-buffer)
+             (message "Searching %s..." group)
+             (let ((arts 0)
+                   (result
+                    (nnimap-command "UID SEARCH  %s"
+                                    (if (string= criteria "")
+                                        qstring
+                                      (nnir-imap-make-query criteria qstring)
+                                      ))))
+               (mapc
+                (lambda (artnum)
+                  (push (vector group artnum 1) artlist)
+                  (setq arts (1+ arts)))
+                (and (car result)
+                     (delete 0 (mapcar #'string-to-number
+                                       (cdr (assoc "SEARCH" (cdr result)))))))
+               (message "Searching %s... %d matches" group arts)))
+           (message "Searching %s...done" group))
+       (quit nil))

       (reverse artlist))))
 
 (defun nnir-imap-make-query (criteria qstring)
       (reverse artlist))))
 
 (defun nnir-imap-make-query (criteria qstring)


@@ -1162,7 +1189,7 @@ Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on
 Windows NT 4.0."
 
   (when group
 Windows NT 4.0."
 
   (when group

-    (error "The swish++ backend cannot search specific groups."))
+    (error "The swish++ backend cannot search specific groups"))

 
   (save-excursion
     (let ( (qstring (cdr (assq 'query query)))
 
   (save-excursion
     (let ( (qstring (cdr (assq 'query query)))


@@ -1179,7 +1206,7 @@ Windows NT 4.0."
            score artno dirnam filenam)
 
       (when (equal "" qstring)
            score artno dirnam filenam)
 
       (when (equal "" qstring)

-        (error "swish++: You didn't enter anything."))
+        (error "swish++: You didn't enter anything"))

 
       (set-buffer (get-buffer-create nnir-tmp-buffer))
       (erase-buffer)
 
       (set-buffer (get-buffer-create nnir-tmp-buffer))
       (erase-buffer)


@@ -1251,7 +1278,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
 
   ;; swish-e crashes with empty parameter to "-w" on commandline...
   (when group
 
   ;; swish-e crashes with empty parameter to "-w" on commandline...
   (when group

-    (error "The swish-e backend cannot search specific groups."))
+    (error "The swish-e backend cannot search specific groups"))

 
   (save-excursion
     (let ((qstring (cdr (assq 'query query)))
 
   (save-excursion
     (let ((qstring (cdr (assq 'query query)))


@@ -1261,7 +1288,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
           artlist score artno dirnam group )
 
       (when (equal "" qstring)
           artlist score artno dirnam group )
 
       (when (equal "" qstring)

-        (error "swish-e: You didn't enter anything."))
+        (error "swish-e: You didn't enter anything"))

 
       (set-buffer (get-buffer-create nnir-tmp-buffer))
       (erase-buffer)
 
       (set-buffer (get-buffer-create nnir-tmp-buffer))
       (erase-buffer)


@@ -1523,17 +1550,13 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
           "find" group "-type" "f" "-name" "[0-9]*" "-exec"
           "grep"
           `("-l" ,@(and grep-options
           "find" group "-type" "f" "-name" "[0-9]*" "-exec"
           "grep"
           `("-l" ,@(and grep-options

-                        ;; Note: the 3rd arg of `split-string' is not
-                        ;; available in Emacs 21.
-                        (delete "" (split-string grep-options "\\s-")))
+                        (split-string grep-options "\\s-" t))

             "-e" ,regexp "{}" "+"))))
 
       ;; Translate relative paths to group names.
       (while (not (eobp))
             "-e" ,regexp "{}" "+"))))
 
       ;; Translate relative paths to group names.
       (while (not (eobp))

-       (let* ((path (delete
-                     ""
-                     (split-string
-                      (buffer-substring (point) (line-end-position)) "/")))
+       (let* ((path (split-string
+                     (buffer-substring (point) (line-end-position)) "/" t))

               (art (string-to-number (car (last path)))))
          (while (string= "." (car path))
            (setq path (cdr path)))
               (art (string-to-number (car (last path)))))
          (while (string= "." (car path))
            (setq path (cdr path)))


@@ -1683,5 +1706,4 @@ The Gnus backend/server information is added."
 ;; The end.
 (provide 'nnir)
 
 ;; The end.
 (provide 'nnir)
 

-;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664

 ;;; nnir.el ends here
 ;;; nnir.el ends here