nnimap.el (nnimap-find-expired-articles): nnimap `never' expiration fix
[gnus] / lisp / nnir.el
index 24f2a55..6d111e8 100644 (file)
@@ -1,6 +1,6 @@
 ;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*-
 
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
 
 ;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
 ;; Swish-e and Swish++ backends by:
 
 ;;; Setup:
 
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
-  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
-
 (require 'nnoo)
 (require 'gnus-group)
 (require 'message)
@@ -288,6 +284,8 @@ is `(valuefunc member)'."
 (eval-when-compile
   (autoload 'nnimap-buffer "nnimap")
   (autoload 'nnimap-command "nnimap")
+  (autoload 'nnimap-capability "nnimap")
+  (autoload 'nnimap-wait-for-line "nnimap")
   (autoload 'nnimap-change-group "nnimap")
   (autoload 'nnimap-make-thread-query "nnimap")
   (autoload 'gnus-registry-action "gnus-registry")
@@ -326,7 +324,7 @@ with three items unique to nnir summary buffers:
 
 If nil this will use `gnus-summary-line-format'."
   :version "24.1"
-  :type '(string)
+  :type '(choice (const :tag "gnus-summary-line-format" nil) string)
   :group 'nnir)
 
 (defcustom nnir-retrieve-headers-override-function nil
@@ -338,7 +336,7 @@ retrieved header format.
 If this variable is nil, or if the provided function returns nil for a search
 result, `gnus-retrieve-headers' will be called instead."
   :version "24.1"
-  :type '(function)
+  :type '(choice (const :tag "gnus-retrieve-headers" nil) function)
   :group 'nnir)
 
 (defcustom nnir-imap-default-search-key "whole message"
@@ -548,15 +546,15 @@ that it is for notmuch, not Namazu."
     (gmane   nnir-run-gmane
             ((gmane-author . "Gmane Author: ")))
     (swish++ nnir-run-swish++
-             ((swish++-group . "Swish++ Group spec: ")))
+             ((swish++-group . "Swish++ Group spec (regexp): ")))
     (swish-e nnir-run-swish-e
-             ((swish-e-group . "Swish-e Group spec: ")))
+             ((swish-e-group . "Swish-e Group spec (regexp): ")))
     (namazu  nnir-run-namazu
              ())
     (notmuch nnir-run-notmuch
              ())
     (hyrex   nnir-run-hyrex
-            ((hyrex-group . "Hyrex Group spec: ")))
+            ((hyrex-group . "Hyrex Group spec (regexp): ")))
     (find-grep nnir-run-find-grep
               ((grep-options . "Grep options: "))))
   "Alist of supported search engines.
@@ -834,7 +832,8 @@ skips all prompting."
 (deffoo nnir-request-update-mark (group article mark)
   (let ((artgroup (nnir-article-group article))
        (artnumber (nnir-article-number article)))
-    (gnus-request-update-mark artgroup artnumber mark)))
+    (when (and artgroup artnumber)
+      (gnus-request-update-mark artgroup artnumber mark))))
 
 (deffoo nnir-request-set-mark (group actions &optional server)
   (nnir-possibly-change-group group server)
@@ -892,6 +891,7 @@ skips all prompting."
 
 
 (deffoo nnir-close-group (group &optional server)
+  (nnir-possibly-change-group group server)
   (let ((pgroup (gnus-group-guess-full-name-from-command-method group)))
     (when (and nnir-artlist (not (gnus-ephemeral-group-p pgroup)))
       (gnus-group-set-parameter  pgroup 'nnir-artlist nnir-artlist))
@@ -970,33 +970,52 @@ details on the language and supported extensions."
        (catch 'found
          (mapcar
           #'(lambda (group)
-            (let (artlist)
-              (condition-case ()
-                  (when (nnimap-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)
-                           (let ((artn (string-to-number artnum)))
-                             (when (> artn 0)
-                               (push (vector group artn 100)
-                                     artlist)
-                               (when (assq 'shortcut query)
-                                 (throw 'found (list artlist)))
-                               (setq arts (1+ arts)))))
-                         (and (car result)
-                             (cdr (assoc "SEARCH" (cdr result)))))
-                        (message "Searching %s... %d matches" group arts)))
-                    (message "Searching %s...done" group))
-                (quit nil))
-              (nreverse artlist)))
+             (let (artlist)
+               (condition-case ()
+                   (when (nnimap-change-group
+                          (gnus-group-short-name group) server)
+                     (with-current-buffer (nnimap-buffer)
+                       (message "Searching %s..." group)
+                       (let* ((arts 0)
+                              (literal+ (nnimap-capability "LITERAL+"))
+                              (search (split-string
+                                       (if (string= criteria "")
+                                           qstring
+                                         (nnir-imap-make-query
+                                         criteria qstring))
+                                       "\n"))
+                              (coding (upcase
+                                       (replace-regexp-in-string
+                                        "-\\(unix\\|dos\\|mac\\)" ""
+                                        (symbol-name
+                                         (cdr default-process-coding-system)))))
+                              call result)
+                         (setq call (nnimap-send-command
+                                       "UID SEARCH CHARSET %s %s" coding (pop search)))
+                         (while search ; Non-ascii search terms
+                           (unless literal+
+                             (nnimap-wait-for-line "^\\+\\(.*\\)\n"))
+                           (process-send-string (get-buffer-process (current-buffer)) (pop search))
+                           (process-send-string (get-buffer-process (current-buffer))
+                              (if (nnimap-newlinep nnimap-object)
+                                  "\n"
+                                "\r\n")))
+                         (setq result (nnimap-get-response call))
+                         (mapc
+                          (lambda (artnum)
+                            (let ((artn (string-to-number artnum)))
+                              (when (> artn 0)
+                                (push (vector group artn 100)
+                                      artlist)
+                                (when (assq 'shortcut query)
+                                  (throw 'found (list artlist)))
+                                (setq arts (1+ arts)))))
+                          (and (car result)
+                               (cdr (assoc "SEARCH" (cdr result)))))
+                         (message "Searching %s... %d matches" group arts)))
+                     (message "Searching %s...done" group))
+                 (quit nil))
+               (nreverse artlist)))
           groups))))))
 
 (defun nnir-imap-make-query (criteria qstring)
@@ -1050,25 +1069,30 @@ In future the following will be added to the language:
 (defun nnir-imap-expr-to-imap (criteria expr)
   "Convert EXPR into an IMAP search expression on CRITERIA"
   ;; What sort of expression is this, eh?
-  (cond
-   ;; Simple string term
-   ((stringp expr)
-    (format "%s %S" criteria expr))
-   ;; Trivial term: and
-   ((eq expr 'and) nil)
-   ;; Composite term: or expression
-   ((eq (car-safe expr) 'or)
-    (format "OR %s %s"
-           (nnir-imap-expr-to-imap criteria (second expr))
-           (nnir-imap-expr-to-imap criteria (third expr))))
-   ;; Composite term: just the fax, mam
-   ((eq (car-safe expr) 'not)
-    (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
-   ;; Composite term: just expand it all.
-   ((and (not (null expr)) (listp expr))
-    (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
-   ;; Complex value, give up for now.
-   (t (error "Unhandled input: %S" expr))))
+  (let ((literal+ (nnimap-capability "LITERAL+")))
+    (cond
+     ;; Simple string term
+     ((stringp expr)
+      (format "%s %S" criteria expr))
+     ;; Trivial term: and
+     ((eq expr 'and) nil)
+     ;; Composite term: or expression
+     ((eq (car-safe expr) 'or)
+      (format "OR %s %s"
+             (nnir-imap-expr-to-imap criteria (second expr))
+             (nnir-imap-expr-to-imap criteria (third expr))))
+     ;; Composite term: just the fax, mam
+     ((eq (car-safe expr) 'not)
+      (format "NOT (%s)" (nnir-imap-query-to-imap criteria (rest expr))))
+     ;; Composite term: non-ascii search term
+     ((numberp (car-safe expr))
+      (format "%s {%d%s}\n%s" criteria (car expr)
+             (if literal+ "+" "") (second expr)))
+     ;; Composite term: just expand it all.
+     ((and (not (null expr)) (listp expr))
+      (format "(%s)" (nnir-imap-query-to-imap criteria expr)))
+     ;; Complex value, give up for now.
+     (t (error "Unhandled input: %S" expr)))))
 
 
 (defun nnir-imap-parse-query (string)
@@ -1110,6 +1134,11 @@ that the search language can then understand and use."
      ((eq term 'and) 'and)
      ;; negated term
      ((eq term 'not) (list 'not (nnir-imap-next-expr)))
+     ;; non-ascii search string
+     ((and (stringp term)
+          (not (= (string-bytes term)
+                  (length term))))
+      (list (string-bytes term) term))
      ;; generic term
      (t term))))
 
@@ -1485,7 +1514,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
 
       (goto-char (point-min))
       (while (re-search-forward
-              "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+              "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
               nil t)
         (setq score (match-string 3)
               group (file-name-directory (match-string 4))