X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnir.el;h=eaaac3f88ceafd2644a69a11e2d3deab36fdacd1;hb=ea7237092488285b9607ec405873715a67fd5bbe;hp=d3ec3d24b58cb9b6b70394b98e5bc9b0d33caad5;hpb=636c865ae736e91a69b91cd28897331e6841ea0b;p=gnus diff --git a/lisp/nnir.el b/lisp/nnir.el index d3ec3d24b..eaaac3f88 100644 --- a/lisp/nnir.el +++ b/lisp/nnir.el @@ -1,7 +1,6 @@ ;;; 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, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1998-2011 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Swish-e and Swish++ backends by: @@ -204,11 +203,12 @@ ;; Imap variables (defvar nnir-imap-search-arguments - '(("Whole message" . "TEXT") - ("Subject" . "SUBJECT") - ("To" . "TO") - ("From" . "FROM") - ("Imap" . "")) + '(("whole message" . "TEXT") + ("subject" . "SUBJECT") + ("to" . "TO") + ("from" . "FROM") + ("body" . "BODY") + ("imap" . "")) "Mapping from user readable keys to IMAP search items for use in nnir") (defvar nnir-imap-search-other "HEADER %S" @@ -289,7 +289,9 @@ is `(valuefunc member)'." (autoload 'nnimap-buffer "nnimap") (autoload 'nnimap-command "nnimap") (autoload 'nnimap-possibly-change-group "nnimap") - (autoload 'gnus-registry-action "gnus-registry")) + (autoload 'gnus-registry-action "gnus-registry") + (defvar gnus-registry-install)) + (nnoo-declare nnir) (nnoo-define-basics nnir) @@ -303,13 +305,6 @@ is `(valuefunc member)'." "Search groups in Gnus with assorted seach engines." :group 'gnus) -(defcustom nnir-method-default-engines - '((nnimap . imap) - (nntp . gmane)) - "*Alist of default search engines keyed by server method." - :type '(alist) - :group 'nnir) - (defcustom nnir-ignored-newsgroups "" "*A regexp to match newsgroups in the active file that should be skipped when searching." @@ -327,7 +322,7 @@ with three items unique to nnir summary buffers: %g Article original short group name (string) If nil this will use `gnus-summary-line-format'." - :type '(regexp) + :type '(string) :group 'nnir) (defcustom nnir-retrieve-headers-override-function nil @@ -341,11 +336,12 @@ result, `gnus-retrieve-headers' will be called instead." :type '(function) :group 'nnir) -(defcustom nnir-imap-default-search-key "Whole message" +(defcustom 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\"." - :type '(string) + :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-imap-search-arguments)) :group 'nnir) (defcustom nnir-swish++-configuration-file @@ -544,6 +540,18 @@ needs the variables `nnir-namazu-program', Add an entry here when adding a new search engine.") +(defcustom nnir-method-default-engines + '((nnimap . imap) + (nntp . gmane)) + "*Alist of default search engines keyed by server method." + :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool) + (const nneething) (const nndir) (const nnmbox) + (const nnml) (const nnmh) (const nndraft) + (const nnfolder) (const nnmaildir)) + (choice + ,@(mapcar (lambda (elem) (list 'const (car elem))) + nnir-engines)))) + :group 'nnir) ;; Gnus glue. @@ -1397,14 +1405,15 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." ;; gmane interface (defun nnir-run-gmane (query srv &optional groups) "Run a search against a gmane back-end server." - (if (gnus-string-match-p "gmane" srv) (let* ((case-fold-search t) (qstring (cdr (assq 'query query))) (server (cadr (gnus-server-to-method srv))) (groupspec (mapconcat (lambda (x) - (format "group:%s" (gnus-group-short-name x))) - groups " ")) + (if (gnus-string-match-p "gmane" x) + (format "group:%s" (gnus-group-short-name x)) + (error "Can't search non-gmane groups: %s" x))) + groups " ")) (authorspec (if (assq 'author query) (format "author:%s" (cdr (assq 'author query))) "")) @@ -1439,9 +1448,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (string-to-number (match-string 2 xref)) xscore) artlist))))) (forward-line 1))) - (apply 'vector (nreverse (mm-delete-duplicates artlist)))) - (message "Can't search non-gmane nntp groups") - nil)) + (apply 'vector (nreverse (mm-delete-duplicates artlist))))) ;;; Util Code: @@ -1494,11 +1501,14 @@ Tested with Namazu 2.0.6 on a GNU/Linux system." (setq search-func (cadr (assoc nnir-search-engine nnir-engines))) (if search-func - (funcall search-func - (if nnir-extra-parms - (nnir-read-parms q nnir-search-engine) - q) - server (cadr x)) + (funcall + search-func + (if nnir-extra-parms + (or (and (eq nnir-search-engine 'imap) + (assq 'criteria q) q) + (setq q (nnir-read-parms q nnir-search-engine))) + q) + server (cadr x)) nil))) groups)))) @@ -1536,7 +1546,8 @@ server is of form 'backend:name'." (let ((cur (current-buffer)) name) (goto-char (point-min)) - (unless (string= nnir-ignored-newsgroups "") + (unless (or (null nnir-ignored-newsgroups) + (string= nnir-ignored-newsgroups "")) (delete-matching-lines nnir-ignored-newsgroups)) (if (eq (car method) 'nntp) (while (not (eobp)) @@ -1582,12 +1593,14 @@ server is of form 'backend:name'." (when (eq (car (gnus-find-method-for-group gnus-newsgroup-name)) 'nnir) (setq gnus-summary-line-format (or nnir-summary-line-format gnus-summary-line-format)) - (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) - (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) - (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t) - (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t) - (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t) - (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))) + (when (and (boundp 'gnus-registry-install) + (eq gnus-registry-install t)) + (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action t) + (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action t) + (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action t) + (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t) + (add-hook 'gnus-summary-article-move-hook 'nnir-registry-action t t) + (add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))))