Add docstrings

[gnus] / lisp / nnir.el

diff --git a/lisp/nnir.el b/lisp/nnir.el
index 84c9d9f..adb8d09 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 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


@@ -78,9 +78,8 @@
 
 ;; Restrictions:
 ;;
 
 ;; Restrictions:
 ;;

-;; * If you don't use HyREX as your search engine, this expects that
-;;   you use nnml or another one-file-per-message backend, because the
-;;   others doesn't support nnfolder.
+;; * This expects that you use nnml or another one-file-per-message backend,
+;;   because the others doesn't support nnfolder.

 ;; * It can only search the mail backend's which are supported by one
 ;;   search engine, because of different query languages.
 ;; * There are restrictions to the Wais setup.
 ;; * It can only search the mail backend's which are supported by one
 ;;   search engine, because of different query languages.
 ;; * There are restrictions to the Wais setup.


@@ -96,8 +95,7 @@
 ;; like this :
 ;;   (setq gnus-secondary-select-methods '(
 ;;       (nnimap "" (nnimap-address "localhost")
 ;; like this :
 ;;   (setq gnus-secondary-select-methods '(
 ;;       (nnimap "" (nnimap-address "localhost")

-;;                  (nnir-search-engine hyrex)
-;;                  (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml"))
+;;                  (nnir-search-engine namazu)

 ;;       )))
 ;; Or you can define the global ones. The variables set in the mailer-
 ;; definition will be used first.
 ;;       )))
 ;; Or you can define the global ones. The variables set in the mailer-
 ;; definition will be used first.


@@ -227,18 +225,7 @@
 ;; For maximum searching efficiency I have a cron job set to run this
 ;; command every four hours.
 
 ;; For maximum searching efficiency I have a cron job set to run this
 ;; command every four hours.
 

-;; 3. HyREX
-;;
-;; The HyREX backend requires you to have one directory from where all
-;; your relative paths are to, if you use them. This directory must be
-;; set in the `nnir-hyrex-index-directory' variable, which defaults to
-;; your home directory. You must also pass the base, class and
-;; directory options or simply your dll to the `nnir-hyrex-programm' by
-;; setting the `nnir-hyrex-additional-switches' variable accordently.
-;; To function the `nnir-hyrex-remove-prefix' variable must also be
-;; correct, see the documentation for `nnir-wais-remove-prefix' above.
-
-;; 4. find-grep
+;; 3. find-grep

 ;;
 ;; The find-grep engine simply runs find(1) to locate eligible
 ;; articles and searches them with grep(1).  This, of course, is much
 ;;
 ;; The find-grep engine simply runs find(1) to locate eligible
 ;; articles and searches them with grep(1).  This, of course, is much


@@ -263,10 +250,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


@@ -319,7 +306,6 @@
 ;;   are simple, but what about the article number?
 ;;   - The article number is encoded in the `X-Gnus-Article-Number'
 ;;     header of each mail.
 ;;   are simple, but what about the article number?
 ;;   - The article number is encoded in the `X-Gnus-Article-Number'
 ;;     header of each mail.

-;;   - The HyREX engine supports nnfolder.

 ;;
 ;; * Support compressed mail files.  Probably, just stripping off the
 ;;   `.gz' or `.Z' file name extension is sufficient.
 ;;
 ;; * Support compressed mail files.  Probably, just stripping off the
 ;;   `.gz' or `.Z' file name extension is sufficient.


@@ -336,28 +322,53 @@
 (require 'gnus-sum)
 (require 'message)
 (require 'gnus-util)
 (require 'gnus-sum)
 (require 'message)
 (require 'gnus-util)

-(eval-and-compile
+(eval-when-compile

   (require 'cl))
 
   (require 'cl))
 

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

 (nnoo-declare nnir)
 (nnoo-define-basics nnir)
 
 (gnus-declare-backend "nnir" 'mail)
 
 (nnoo-declare nnir)
 (nnoo-define-basics nnir)
 
 (gnus-declare-backend "nnir" 'mail)
 

-(defvar nnir-imap-search-field "TEXT"
-  "The IMAP search item when doing an nnir search")
+(defvar 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\"")

 
 (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\""))
-  "Mapping from user readable strings to IMAP search items for use in nnir")
+    ("Imap" . ""))
+  "Mapping from user readable keys to IMAP search items for use in nnir")
+
+(defvar nnir-imap-search-other "HEADER %S"
+  "The IMAP search item to use for anything other than
+  nnir-imap-search-arguments. By default this is the name of an
+  email header field")

 
 (defvar nnir-imap-search-argument-history ()
   "The history for querying search options 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.")
+
+(defvar nnir-method-default-engines
+  '((nnimap . imap)
+    (nntp . nil))
+  "Alist of default search engines by server method")
+

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


@@ -365,13 +376,12 @@
              ())
     (imap    nnir-run-imap
              ((criteria
              ())
     (imap    nnir-run-imap
              ((criteria

-              "Search in: "                      ; Prompt
-              ,nnir-imap-search-arguments        ; alist for completing
-              nil                                ; no filtering
+              "Search in"                        ; Prompt
+              ,(mapcar 'car nnir-imap-search-arguments) ; alist for completing

               nil                                ; allow any user input
               nil                                ; initial value
               nnir-imap-search-argument-history  ; the history to use
               nil                                ; allow any user input
               nil                                ; initial value
               nnir-imap-search-argument-history  ; the history to use

-              ,nnir-imap-search-field            ; default
+              ,nnir-imap-default-search-key      ; default

               )))
     (swish++ nnir-run-swish++
              ((group . "Group spec: ")))
               )))
     (swish++ nnir-run-swish++
              ((group . "Group spec: ")))


@@ -379,10 +389,8 @@
              ((group . "Group spec: ")))
     (namazu  nnir-run-namazu
              ())
              ((group . "Group spec: ")))
     (namazu  nnir-run-namazu
              ())

-    (hyrex   nnir-run-hyrex
-            ((group . "Group spec: ")))
-  (find-grep nnir-run-find-grep
-            ((grep-options . "Grep options: "))))
+    (find-grep nnir-run-find-grep
+              ((grep-options . "Grep options: "))))

   "Alist of supported search engines.
 Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
 ENGINE is a symbol designating the searching engine.  FUNCTION is also
   "Alist of supported search engines.
 Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
 ENGINE is a symbol designating the searching engine.  FUNCTION is also


@@ -499,13 +507,12 @@ that it is for swish++, not Wais."
   :group 'nnir)
 
 ;; Swish-E.
   :group 'nnir)
 
 ;; Swish-E.

-;; URL: http://sunsite.berkeley.edu/SWISH-E/
-;; New version: http://www.boe.es/swish-e
+;; URL: http://swish-e.org/

 ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and
 ;; `nnir-swish-e-additional-switches'
 
 (make-obsolete-variable 'nnir-swish-e-index-file
 ;; Variables `nnir-swish-e-index-file', `nnir-swish-e-program' and
 ;; `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.
 (defcustom nnir-swish-e-index-file
   (expand-file-name "~/Mail/index.swish-e")
   "*Index file for swish-e.


@@ -552,41 +559,7 @@ This could be a server parameter."
   :type '(regexp)
   :group 'nnir)
 
   :type '(regexp)
   :group 'nnir)
 

-;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/>
-
-(defcustom nnir-hyrex-program "nnir-search"
-  "*Name of the nnir-search executable."
-  :type '(string)
-  :group 'nnir)
-
-(defcustom nnir-hyrex-additional-switches '()
-  "*A list of strings, to be given as additional arguments for nnir-search.
-Note that this should be a list. Ie, do NOT use the following:
-    (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong !
-Instead, use this:
-    (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
-  :type '(repeat (string))
-  :group 'nnir)
-
-(defcustom nnir-hyrex-index-directory (getenv "HOME")
-  "*Index directory for HyREX."
-  :type '(directory)
-  :group 'nnir)
-
-(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/")
-  "*The prefix to remove from each file name returned by HyREX
-in order to get a group name (albeit with / instead of .).
-
-For example, suppose that HyREX returns file names such as
-\"/home/john/Mail/mail/misc/42\".  For this example, use the following
-setting:  (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\")
-Note the trailing slash.  Removing this prefix gives \"mail/misc/42\".
-`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
-arrive at the correct group name, \"mail.misc\"."
-  :type '(directory)
-  :group 'nnir)
-
-;; Namazu engine, see <URL:http://ww.namazu.org/>
+;; Namazu engine, see <URL:http://www.namazu.org/>

 
 (defcustom nnir-namazu-program "namazu"
   "*Name of Namazu search executable."
 
 (defcustom nnir-namazu-program "namazu"
   "*Name of Namazu search executable."


@@ -658,16 +631,6 @@ that it is for Namazu, not Wais."
            gnus-current-window-configuration)
      nil)))
 
            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))
-(add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook)
-

 ;; Why is this needed? Is this for compatibility with old/new gnusae? Using
 ;; gnus-group-server instead works for me.  -- Justus Piater
 (defmacro nnir-group-server (group)
 ;; Why is this needed? Is this for compatibility with old/new gnusae? Using
 ;; gnus-group-server instead works for me.  -- Justus Piater
 (defmacro nnir-group-server (group)


@@ -690,23 +653,34 @@ 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))

-        server backend-group)
-    (setq server (nnir-group-server group))
-    (setq backend-group (gnus-group-real-name group))
-    (gnus-group-read-ephemeral-group
-     backend-group
-     (gnus-server-to-method server)
-     t                                  ; activate
-     (cons (current-buffer)
-           'summary)                    ; window config
-     nil
-     (list backend-number))
-    (gnus-summary-limit (list backend-number))
-    (gnus-summary-refer-thread)))
+        (id (mail-header-id (gnus-summary-article-header)))
+        (refs (split-string
+               (mail-header-references (gnus-summary-article-header)))))
+    (if (eq (car (gnus-group-method group)) 'nnimap)
+       (progn (nnimap-possibly-change-group (gnus-group-short-name group) nil)
+              (with-current-buffer (nnimap-buffer)
+                (let* ((cmd (let ((value (format
+                                          "(OR HEADER REFERENCES %s HEADER Message-Id %s)"
+                                          id id)))
+                              (dolist (refid refs value)
+                                (setq value (format
+                                             "(OR (OR HEADER Message-Id %s HEADER REFERENCES %s) %s)"
+                                             refid refid value)))))
+                       (result (nnimap-command
+                                "UID SEARCH %s" cmd)))
+                  (gnus-summary-read-group-1 group t t gnus-summary-buffer nil
+                                             (and (car result)
+                                                  (delete 0 (mapcar #'string-to-number
+                                                                    (cdr (assoc "SEARCH" (cdr result))))))))))
+      (gnus-summary-read-group-1 group t t gnus-summary-buffer
+                                nil (list backend-number))
+      (gnus-summary-limit (list backend-number))
+      (gnus-summary-refer-thread))))
+

 
 (if (fboundp 'eval-after-load)
     (eval-after-load "gnus-sum"
 
 (if (fboundp 'eval-after-load)
     (eval-after-load "gnus-sum"


@@ -725,7 +699,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 +710,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,38 +752,34 @@ 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)))
+             (headers
+              (goto-char (point-min))
+              (setq novitem (nnheader-parse-head)))
+             (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
        ;; replace article number in original group with article number
         ;; in nnir group

-        (mail-header-set-number novitem art)
-        (mail-header-set-from novitem
-                              (mail-header-from novitem))
-        (mail-header-set-subject
-         novitem
-         (format "[%d: %s/%d] %s"
-                 artrsv artgroup artno
-                 (mail-header-subject novitem)))
-        ;;-(mail-header-set-extra novitem nil)
-        (push novitem novdata)
-        (setq artlist (cdr artlist)))
+       (when novitem
+         (mail-header-set-number novitem art)
+         (mail-header-set-from novitem
+                               (mail-header-from novitem))
+         (mail-header-set-subject
+          novitem
+          (format "[%d: %s/%d] %s"
+                  artrsv artgroup artno
+                  (mail-header-subject novitem)))
+         (push novitem novdata)
+         (setq artlist (cdr artlist))))

       (setq novdata (nreverse novdata))
       (set-buffer nntp-server-buffer) (erase-buffer)
       (mapc 'nnheader-insert-nov novdata)
       (setq novdata (nreverse novdata))
       (set-buffer nntp-server-buffer) (erase-buffer)
       (mapc 'nnheader-insert-nov novdata)


@@ -866,7 +835,9 @@ ready to be added to the list of search results."
   (when (file-readable-p (concat prefix dirnam article))
     ;; remove trailing slash and, for nnmaildir, cur/new/tmp
     (setq dirnam
   (when (file-readable-p (concat prefix dirnam article))
     ;; remove trailing slash and, for nnmaildir, cur/new/tmp
     (setq dirnam

-         (substring dirnam 0 (if (string= server "nnmaildir:") -5 -1)))
+         (substring dirnam 0
+                    (if (string= (gnus-group-server server) "nnmaildir")
+                        -5 -1)))

 
     ;; Set group to dirnam without any leading dots or slashes,
     ;; and with all subsequent slashes replaced by dots
 
     ;; Set group to dirnam without any leading dots or slashes,
     ;; and with all subsequent slashes replaced by dots


@@ -875,7 +846,7 @@ ready to be added to the list of search results."
                  "[/\\]" "." t)))
 
     (vector (nnir-group-full-name group server)
                  "[/\\]" "." t)))
 
     (vector (nnir-group-full-name group server)

-           (if (string= server "nnmaildir:")
+           (if (string= (gnus-group-server server) "nnmaildir")

                (nnmaildir-base-name-to-article-number
                 (substring article 0 (string-match ":" article))
                 group nil)
                (nnmaildir-base-name-to-article-number
                 (substring article 0 (string-match ":" article))
                 group nil)


@@ -889,7 +860,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))


@@ -916,31 +887,24 @@ pairs (also vectors, actually)."
         (unless (string-match prefix dirnam)
           (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
                            dirnam prefix))
         (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
         (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:
 
 ;; IMAP interface.
 ;; todo:

-;; nnir invokes this two (2) times???!
-;; we should not use nnimap at all but open our own server connection
-;; we should not LIST * but use nnimap-list-pattern from defs

 ;; send queries as literals
 ;; handle errors
 
 ;; send queries as literals
 ;; handle errors
 

-(autoload 'nnimap-open-server "nnimap")
-(defvar nnimap-server-buffer) ;; nnimap.el
-(autoload 'imap-mailbox-select "imap")
-(autoload 'imap-search "imap")
-(autoload 'imap-quote-specials "imap")

 
 (defun nnir-run-imap (query srv &optional group-option)
   "Run a search against an IMAP back-end server.
 
 (defun nnir-run-imap (query srv &optional group-option)
   "Run a search against an IMAP back-end server.


@@ -952,24 +916,32 @@ details on the language and supported extensions"
          (group (or group-option (gnus-group-group-name)))
          (defs (caddr (gnus-server-to-method srv)))
          (criteria (or (cdr (assq 'criteria query))
          (group (or group-option (gnus-group-group-name)))
          (defs (caddr (gnus-server-to-method srv)))
          (criteria (or (cdr (assq 'criteria query))

-                       nnir-imap-search-field))
-         artlist buf)
+                       (cdr (assoc nnir-imap-default-search-key
+                                   nnir-imap-search-arguments))))
+         (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)


@@ -1026,7 +998,7 @@ In future the following will be added to the language:
   (cond
    ;; Simple string term
    ((stringp expr)
   (cond
    ;; Simple string term
    ((stringp expr)

-    (format "%s \"%s\"" criteria (imap-quote-specials expr)))
+    (format "%s %S" criteria expr))

    ;; Trivial term: and
    ((eq expr 'and) nil)
    ;; Composite term: or expression
    ;; Trivial term: and
    ((eq expr 'and) nil)
    ;; Composite term: or expression


@@ -1161,7 +1133,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)))


@@ -1172,13 +1144,13 @@ Windows NT 4.0."
           ;; is sufficient.  Note that we can't only use the value of
           ;; nnml-use-compressed-files because old articles might have been
           ;; saved with a different value.
           ;; is sufficient.  Note that we can't only use the value of
           ;; nnml-use-compressed-files because old articles might have been
           ;; saved with a different value.

-          (article-pattern (if (string= server "nnmaildir:")
+          (article-pattern (if (string= (gnus-group-server server) "nnmaildir")

                                ":[0-9]+"
                              "^[0-9]+\\(\\.[a-z0-9]+\\)?$"))
            score artno dirnam filenam)
 
       (when (equal "" qstring)
                                ":[0-9]+"
                              "^[0-9]+\\(\\.[a-z0-9]+\\)?$"))
            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)


@@ -1235,10 +1207,10 @@ Windows NT 4.0."
 
       ;; Sort by score
       (apply 'vector
 
       ;; 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)
 
 ;; Swish-E interface.
 (defun nnir-run-swish-e (query server &optional group)


@@ -1250,7 +1222,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)))


@@ -1260,7 +1232,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)


@@ -1316,9 +1288,9 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
            ;; eliminate all ".", "/", "\" from beginning. Always matches.
             (string-match "^[./\\]*\\(.*\\)$" dirnam)
             ;; "/" -> "."
            ;; 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 "\\" -> "."
             ;; Windows "\\" -> "."

-            (setq group (substitute ?. ?\\ group))
+            (setq group (gnus-replace-in-string group "\\\\" "."))

 
             (push (vector (nnir-group-full-name group server)
                           (string-to-number artno)
 
             (push (vector (nnir-group-full-name group server)
                           (string-to-number artno)


@@ -1329,88 +1301,10 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
 
       ;; Sort by score
       (apply 'vector
 
       ;; Sort by score
       (apply 'vector

-             (sort* artlist
-                    (function (lambda (x y)
-                                (> (nnir-artitem-rsv x)
-                                   (nnir-artitem-rsv y)))))))))
-
-;; HyREX interface
-(defun nnir-run-hyrex (query server &optional group)
-  (save-excursion
-    (let ((artlist nil)
-          (groupspec (cdr (assq 'group query)))
-          (qstring (cdr (assq 'query query)))
-         (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server))
-         score artno dirnam)
-      (when (and group groupspec)
-        (error (concat "It does not make sense to use a group spec"
-                       " with process-marked groups.")))
-      (when group
-        (setq groupspec (gnus-group-real-name group)))
-      (when (and group (not (equal group (nnir-group-full-name groupspec server))))
-       (message "%s vs. %s" group (nnir-group-full-name groupspec server))
-       (error "Server with groupspec doesn't match group !"))
-      (set-buffer (get-buffer-create nnir-tmp-buffer))
-      (erase-buffer)
-      (if groupspec
-          (message "Doing hyrex-search query %s on %s..." query groupspec)
-        (message "Doing hyrex-search query %s..." query))
-      (let* ((cp-list
-             `( ,nnir-hyrex-program
-                nil                    ; input from /dev/null
-                t                      ; output
-                nil                    ; don't redisplay
-                "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory
-                ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server)
-                ,qstring          ; the query, in hyrex-search format
-                ))
-             (exitstatus
-              (progn
-                (message "%s args: %s" nnir-hyrex-program
-                         (mapconcat 'identity (cddddr cp-list) " "))
-                (apply 'call-process cp-list))))
-        (unless (or (null exitstatus)
-                    (zerop exitstatus))
-          (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus)
-          ;; nnir-search failure reason is in this buffer, show it if
-          ;; the user wants it.
-          (when (> gnus-verbose 6)
-            (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer !
-      (if groupspec
-          (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec)
-        (message "Doing hyrex-search query \"%s\"...done" qstring))
-      (sit-for 0)
-      ;; nnir-search returns:
-      ;;   for nnml/nnfolder: "filename mailid weigth"
-      ;;   for nnimap:        "group mailid weigth"
-      (goto-char (point-min))
-      (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$")
-      ;; HyREX couldn't search directly in groups -- so filter out here.
-      (when groupspec
-       (keep-lines groupspec))
-      ;; extract data from result lines
-      (goto-char (point-min))
-      (while (re-search-forward
-             "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t)
-       (setq dirnam (match-string 1)
-             artno (match-string 2)
-             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)
-                     (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)
+                               (> (nnir-artitem-rsv x)
+                                  (nnir-artitem-rsv y)))))))))

 
 ;; Namazu interface
 (defun nnir-run-namazu (query server &optional group)
 
 ;; Namazu interface
 (defun nnir-run-namazu (query server &optional group)


@@ -1421,7 +1315,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
   (when group
     (error "The Namazu backend cannot search specific groups"))
   (save-excursion
   (when group
     (error "The Namazu backend cannot search specific groups"))
   (save-excursion

-    (let ((article-pattern (if (string= server "nnmaildir:")
+    (let ((article-pattern (if (string= (gnus-group-server server) "nnmaildir")

                               ":[0-9]+"
                             "^[0-9]+$"))
           artlist
                               ":[0-9]+"
                             "^[0-9]+$"))
           artlist


@@ -1476,10 +1370,10 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
 
       ;; sort artlist by score
       (apply 'vector
 
       ;; 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."
 
 (defun nnir-run-find-grep (query server &optional group)
   "Run find and grep to obtain matching articles."


@@ -1505,11 +1399,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
                 "."
               ;; 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
        (unless group
          (error "Cannot locate directory for group"))
        (save-excursion


@@ -1518,21 +1415,24 @@ 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)))

-         (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)))
            (push (vector (nnir-group-full-name group server) art 0)
                  artlist))
          (forward-line 1)))


@@ -1553,9 +1453,9 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
   (let ((sym (car parmspec))
         (prompt (cdr parmspec)))
     (if (listp prompt)
   (let ((sym (car parmspec))
         (prompt (cdr parmspec)))
     (if (listp prompt)

-       (let* ((result (apply 'completing-read prompt))
+       (let* ((result (apply 'gnus-completing-read prompt))

               (mapping (or (assoc result nnir-imap-search-arguments)
               (mapping (or (assoc result nnir-imap-search-arguments)

-                           (assoc nil nnir-imap-search-arguments))))
+                           (cons nil nnir-imap-search-other))))

          (cons sym (format (cdr mapping) result)))
       (cons sym (read-string prompt)))))
 
          (cons sym (format (cdr mapping) result)))
       (cons sym (read-string prompt)))))
 


@@ -1567,24 +1467,37 @@ and concat the results."
     (if gnus-group-marked
        (apply 'vconcat
               (mapcar (lambda (x)
     (if gnus-group-marked
        (apply 'vconcat
               (mapcar (lambda (x)

-                        (let ((server (nnir-group-server x))
-                              search-func)
+                        (let* ((server (nnir-group-server x))
+                               (engine
+                                (or (nnir-read-server-parm 'nnir-search-engine
+                                                           server)
+                                    (cdr
+                                     (assoc (car (gnus-server-to-method server))
+                                            nnir-method-default-engines))))
+                               search-func)

                           (setq search-func (cadr
                                              (assoc
                           (setq search-func (cadr
                                              (assoc

-                                              (nnir-read-server-parm 'nnir-search-engine server) nnir-engines)))
+                                              engine
+                                              nnir-engines)))

                           (if search-func
                               (funcall search-func q server x)
                             nil)))
                           (if search-func
                               (funcall search-func q server x)
                             nil)))

-                      gnus-group-marked)
-              )
+                      gnus-group-marked))

       (apply 'vconcat
             (mapcar (lambda (x)
                       (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral")))
       (apply 'vconcat
             (mapcar (lambda (x)
                       (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral")))

-                          (let ((server (format "%s:%s" (caar x) (cadar x)))
-                                search-func)
+                          (let* ((server (format "%s:%s" (caar x) (cadar x)))
+                                 (engine
+                                  (or (nnir-read-server-parm 'nnir-search-engine
+                                                             server)
+                                      (cdr
+                                       (assoc (car (gnus-server-to-method server))
+                                              nnir-method-default-engines))))
+                                 search-func)

                             (setq search-func (cadr
                                                (assoc
                             (setq search-func (cadr
                                                (assoc

-                                                (nnir-read-server-parm 'nnir-search-engine server) nnir-engines)))
+                                                engine
+                                                nnir-engines)))

                             (if search-func
                                 (funcall search-func q server nil)
                               nil))
                             (if search-func
                                 (funcall search-func q server nil)
                               nil))


@@ -1671,5 +1584,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