Give a better error message in the "go offline" case.
[gnus] / lisp / nnir.el
index df83f18..a826b5b 100644 (file)
@@ -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, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+;;   2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
 ;; Swish-e and Swish++ backends by:
 ;; IMAP search improved by Daniel Pittman  <daniel@rimspace.net>.
 ;; nnmaildir support for Swish++ and Namazu backends by:
 ;;   Justus Piater <Justus <at> Piater.name>
+;; Keywords: news mail searching ir
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
 
 ;; TODO: Documentation in the Gnus manual
 
 ;; `gnus-group-make-nnir-group' might be described in (info
 ;; "(gnus)Foreign Groups") as well.
 
-;; Keywords: news mail searching ir
-
-;; This file is part of GNU Emacs.
-
-;; This is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
 
 ;; 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
 
 ;; 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
 (require 'gnus-sum)
 (require 'message)
 (require 'gnus-util)
-(eval-and-compile
+(eval-when-compile
   (require 'cl))
 
 (nnoo-declare 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
   `((wais    nnir-run-waissearch
              ())
     (imap    nnir-run-imap
-             ((criteria 
+             ((criteria
               "Search in: "                      ; Prompt
               ,nnir-imap-search-arguments        ; alist for completing
               nil                                ; no filtering
@@ -507,7 +513,7 @@ that it is for swish++, not Wais."
 ;; `nnir-swish-e-additional-switches'
 
 (make-obsolete-variable 'nnir-swish-e-index-file
-                       'nnir-swish-e-index-files)
+                       'nnir-swish-e-index-files "Emacs 23.1")
 (defcustom nnir-swish-e-index-file
   (expand-file-name "~/Mail/index.swish-e")
   "*Index file for swish-e.
@@ -660,6 +666,11 @@ that it is for Namazu, not Wais."
            gnus-current-window-configuration)
      nil)))
 
+(eval-when-compile
+  (when (featurep 'xemacs)
+    ;; The `kbd' macro requires that the `read-kbd-macro' macro is available.
+    (require 'edmacro)))
+
 (defun nnir-group-mode-hook ()
   (define-key gnus-group-mode-map (kbd "G G")
     'gnus-group-make-nnir-group))
@@ -687,7 +698,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)))
-    (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))
@@ -722,7 +733,7 @@ and show thread that contains this article."
   ;; 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.
@@ -733,8 +744,7 @@ and show thread that contains this article."
       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
@@ -776,25 +786,31 @@ and show thread that contains this article."
        (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)
@@ -842,7 +858,7 @@ and show thread that contains this article."
 
 
 (defmacro nnir-add-result (dirnam artno score prefix server artlist)
-  "Ask `nnir-compose-result' to construct a result vector, 
+  "Ask `nnir-compose-result' to construct a result vector,
 and if it is non-nil, add it to artlist."
   `(let ((result (nnir-compose-result ,dirnam ,artno ,score ,prefix ,server)))
      (when (not (null result))
@@ -886,7 +902,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
-    (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))
@@ -913,17 +929,18 @@ pairs (also vectors, actually)."
         (unless (string-match prefix dirnam)
           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
                            dirnam prefix))
-        (setq group (substitute ?. ?/ (replace-match "" t t dirnam)))
+        (setq group (gnus-replace-in-string
+                     (replace-match "" t t dirnam) "/" "."))
         (push (vector (nnir-group-full-name group server)
                       (string-to-number artno)
                       (string-to-number score))
               artlist))
       (message "Massaging waissearch output...done")
       (apply 'vector
-             (sort* artlist
-                    (function (lambda (x y)
-                                (> (nnir-artitem-rsv x)
-                                   (nnir-artitem-rsv y)))))))))
+             (sort artlist
+                   (function (lambda (x y)
+                               (> (nnir-artitem-rsv x)
+                                  (nnir-artitem-rsv y)))))))))
 
 ;; IMAP interface.
 ;; todo:
@@ -977,7 +994,7 @@ This implements a little language designed to return the expected results
 to an arbitrary query string to the end user.
 
 The search is always case-insensitive, as defined by RFC2060, and supports
-the following features (inspired by the Google search input language): 
+the following features (inspired by the Google search input language):
 
 Automatic \"and\" queries
     If you specify multiple words then they will be treated as an \"and\"
@@ -1138,7 +1155,7 @@ returning the one at the supplied position."
   "Are we at the end of input?"
   (skip-chars-forward "[[:blank:]]")
   (looking-at "$"))
-  
+
 
 ;; Swish++ interface.
 ;; -cc- Todo
@@ -1158,7 +1175,7 @@ Tested with swish++ 4.7 on GNU/Linux and with swish++ 5.0b2 on
 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)))
@@ -1175,7 +1192,7 @@ Windows NT 4.0."
            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)
@@ -1232,10 +1249,10 @@ Windows NT 4.0."
 
       ;; Sort by score
       (apply 'vector
-             (sort* artlist
-                    (function (lambda (x y)
-                                (> (nnir-artitem-rsv x)
-                                   (nnir-artitem-rsv y)))))))))
+             (sort artlist
+                   (function (lambda (x y)
+                               (> (nnir-artitem-rsv x)
+                                  (nnir-artitem-rsv y)))))))))
 
 ;; Swish-E interface.
 (defun nnir-run-swish-e (query server &optional group)
@@ -1247,7 +1264,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
-    (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)))
@@ -1257,7 +1274,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
           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)
@@ -1313,9 +1330,9 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
            ;; eliminate all ".", "/", "\" from beginning. Always matches.
             (string-match "^[./\\]*\\(.*\\)$" dirnam)
             ;; "/" -> "."
-            (setq group (substitute ?. ?/ (match-string 1 dirnam)))
+            (setq group (gnus-replace-in-string (match-string 1 dirnam) "/" "."))
             ;; Windows "\\" -> "."
-            (setq group (substitute ?. ?\\ group))
+            (setq group (gnus-replace-in-string group "\\\\" "."))
 
             (push (vector (nnir-group-full-name group server)
                           (string-to-number artno)
@@ -1326,10 +1343,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
 
       ;; Sort by score
       (apply 'vector
-             (sort* artlist
-                    (function (lambda (x y)
-                                (> (nnir-artitem-rsv x)
-                                   (nnir-artitem-rsv y)))))))))
+             (sort artlist
+                   (function (lambda (x y)
+                               (> (nnir-artitem-rsv x)
+                                  (nnir-artitem-rsv y)))))))))
 
 ;; HyREX interface
 (defun nnir-run-hyrex (query server &optional group)
@@ -1394,19 +1411,20 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
              score (match-string 3))
        (when (string-match prefix dirnam)
          (setq dirnam (replace-match "" t t dirnam)))
-       (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server)
+       (push (vector (nnir-group-full-name
+                       (gnus-replace-in-string dirnam "/" ".") server)
                      (string-to-number artno)
                      (string-to-number score))
              artlist))
       (message "Massaging hyrex-search output...done.")
       (apply 'vector
-            (sort* artlist
-                   (function (lambda (x y)
-                               (if (string-lessp (nnir-artitem-group x)
-                                                 (nnir-artitem-group y))
-                                   t
-                                 (< (nnir-artitem-number x)
-                                    (nnir-artitem-number y)))))))
+            (sort artlist
+                   (function (lambda (x y)
+                               (if (string-lessp (nnir-artitem-group x)
+                                                 (nnir-artitem-group y))
+                                   t
+                                 (< (nnir-artitem-number x)
+                                    (nnir-artitem-number y)))))))
       )))
 
 ;; Namazu interface
@@ -1473,10 +1491,10 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
 
       ;; sort artlist by score
       (apply 'vector
-             (sort* artlist
-                    (function (lambda (x y)
-                                (> (nnir-artitem-rsv x)
-                                   (nnir-artitem-rsv y)))))))))
+             (sort artlist
+                   (function (lambda (x y)
+                               (> (nnir-artitem-rsv x)
+                                  (nnir-artitem-rsv y)))))))))
 
 (defun nnir-run-find-grep (query server &optional group)
   "Run find and grep to obtain matching articles."
@@ -1502,11 +1520,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
                 "."
               ;; Try accessing the group literally as well as
               ;; interpreting dots as directory separators so the
-              ;; engine works with plain nnml as well as the Gnus
-              ;; Cache.
-              (find-if 'file-directory-p
-               (let ((group (gnus-group-real-name group)))
-                 (list group (gnus-replace-in-string group "\\." "/" t)))))))
+              ;; engine works with plain nnml as well as the Gnus Cache.
+               (let ((group (gnus-group-real-name group)))
+                 ;; Replace cl-func find-if.
+                 (if (file-directory-p group)
+                     group
+                   (if (file-directory-p
+                        (setq group (gnus-replace-in-string group "\\." "/" t)))
+                       group))))))
        (unless group
          (error "Cannot locate directory for group"))
        (save-excursion
@@ -1514,17 +1535,29 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
           'call-process "find" nil t
           "find" group "-type" "f" "-name" "[0-9]*" "-exec"
           "grep"
-          `("-l" ,@(and grep-options (split-string grep-options "\\s-" t))
+          `("-l" ,@(and grep-options
+                        ;; Note: the 3rd arg of `split-string' is not
+                        ;; available in Emacs 21.
+                        (delete "" (split-string grep-options "\\s-")))
             "-e" ,regexp "{}" "+"))))
 
       ;; Translate relative paths to group names.
       (while (not (eobp))
-       (let* ((path (split-string
-                     (buffer-substring (point) (line-end-position)) "/" t))
+       (let* ((path (delete
+                     ""
+                     (split-string
+                      (buffer-substring (point) (line-end-position)) "/")))
               (art (string-to-number (car (last path)))))
          (while (string= "." (car path))
            (setq path (cdr path)))
-         (let ((group (mapconcat 'identity (subseq path 0 -1) ".")))
+         (let ((group (mapconcat 'identity
+                                  ;; Replace cl-func: (subseq path 0 -1)
+                                  (let ((end (1- (length path)))
+                                        res)
+                                    (while (>= (setq end (1- end)) 0)
+                                      (push (pop path) res))
+                                    (nreverse res))
+                                  ".")))
            (push (vector (nnir-group-full-name group server) art 0)
                  artlist))
          (forward-line 1)))
@@ -1663,4 +1696,4 @@ The Gnus backend/server information is added."
 ;; The end.
 (provide 'nnir)
 
-;;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664
+;;; nnir.el ends here