X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnir.el;h=de304bf216b1cb6a97df8cdb7fc26a0a4ddd2189;hb=b80cf402f0afc69967fedf0ffdd8efe41cff1144;hp=d72bb69d52ca35a5296ae3fae97f070d2345a2e5;hpb=fe594e071388508aa408f975b8d40c955cc3dbbd;p=gnus diff --git a/lisp/nnir.el b/lisp/nnir.el index d72bb69d5..de304bf21 100644 --- 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, -;; 2007, 2008, 2009 Free Software Foundation, Inc. +;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Swish-e and Swish++ backends by: @@ -52,7 +52,7 @@ ;; 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 @@ -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' -;; 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 @@ -345,19 +345,29 @@ (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") - (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") +(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 @@ -725,7 +735,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. @@ -736,8 +746,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 @@ -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))) - (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) @@ -866,7 +881,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 - (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 @@ -875,7 +892,7 @@ ready to be added to the list of search results." "[/\\]" "." 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) @@ -943,6 +960,11 @@ pairs (also vectors, actually)." (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 @@ -954,23 +976,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)) - artlist buf) + (gnus-inhibit-demon t) + artlist) (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) @@ -1173,7 +1202,7 @@ 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. - (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) @@ -1423,7 +1452,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (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 @@ -1523,17 +1552,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 - ;; 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)) - (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))) @@ -1565,7 +1590,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (let ((sym (car parmspec)) (prompt (cdr parmspec))) (if (listp prompt) - (let* ((result (apply 'completing-read prompt)) + (let* ((result (gnus-completing-read prompt nil)) (mapping (or (assoc result nnir-imap-search-arguments) (assoc nil nnir-imap-search-arguments)))) (cons sym (format (cdr mapping) result))) @@ -1683,5 +1708,4 @@ The Gnus backend/server information is added." ;; The end. (provide 'nnir) -;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664 ;;; nnir.el ends here