X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;ds=inline;f=lisp%2Fnnir.el;h=1d787035659541b1438791a9a55f3b048bc336f9;hb=dee0c694f05b79f8ee3a20ec30064c829288ef44;hp=9840dddcb66bbdc62533282558d7d183d98b641b;hpb=72b03f92bf33dbb38241e7c6092fb3d561601675;p=gnus diff --git a/lisp/nnir.el b/lisp/nnir.el index 9840dddcb..1d7870356 100644 --- a/lisp/nnir.el +++ b/lisp/nnir.el @@ -1,6 +1,6 @@ ;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*- -;; Copyright (C) 1998-2011 Free Software Foundation, Inc. +;; Copyright (C) 1998-2012 Free Software Foundation, Inc. ;; Author: Kai Großjohann ;; Swish-e and Swish++ backends by: @@ -288,10 +288,9 @@ is `(valuefunc member)'." (eval-when-compile (autoload 'nnimap-buffer "nnimap") (autoload 'nnimap-command "nnimap") - (autoload 'nnimap-possibly-change-group "nnimap") - (autoload 'gnus-registry-action "gnus-registry") - (defvar gnus-registry-install)) - + (autoload 'nnimap-change-group "nnimap") + (autoload 'nnimap-make-thread-query "nnimap") + (autoload 'gnus-registry-action "gnus-registry")) (nnoo-declare nnir) (nnoo-define-basics nnir) @@ -299,18 +298,19 @@ is `(valuefunc member)'." (defvoo nnir-address nil "The address of the nnir server.") -(gnus-declare-backend "nnir" 'mail) +(gnus-declare-backend "nnir" 'mail 'virtual) ;;; User Customizable Variables: (defgroup nnir nil - "Search groups in Gnus with assorted seach engines." + "Search groups in Gnus with assorted search engines." :group 'gnus) (defcustom nnir-ignored-newsgroups "" "*A regexp to match newsgroups in the active file that should be skipped when searching." + :version "24.1" :type '(regexp) :group 'nnir) @@ -325,6 +325,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'." + :version "24.1" :type '(string) :group 'nnir) @@ -336,6 +337,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) :group 'nnir) @@ -343,6 +345,7 @@ result, `gnus-retrieve-headers' will be called instead." "*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\"." + :version "24.1" :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem))) nnir-imap-search-arguments)) :group 'nnir) @@ -504,6 +507,7 @@ arrive at the correct group name, \"mail.misc\"." (defcustom nnir-notmuch-program "notmuch" "*Name of notmuch search executable." + :version "24.1" :type '(string) :group 'nnir) @@ -514,6 +518,7 @@ Note that this should be a list. Ie, do NOT use the following: (setq nnir-notmuch-additional-switches \"-i -w\") ; wrong Instead, use this: (setq nnir-notmuch-additional-switches '(\"-i\" \"-w\"))" + :version "24.1" :type '(repeat (string)) :group 'nnir) @@ -524,6 +529,7 @@ regular expression. This variable is very similar to `nnir-namazu-remove-prefix', except that it is for notmuch, not Namazu." + :version "24.1" :type '(regexp) :group 'nnir) @@ -574,6 +580,7 @@ Add an entry here when adding a new search engine.") '((nnimap . imap) (nntp . gmane)) "*Alist of default search engines keyed by server method." + :version "24.1" :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool) (const nneething) (const nndir) (const nnmbox) (const nnml) (const nnmh) (const nndraft) @@ -671,7 +678,8 @@ Add an entry here when adding a new search engine.") (goto-char (point-min)) (while (not (eobp)) (let* ((novitem (funcall parsefunc)) - (artno (mail-header-number novitem)) + (artno (and novitem + (mail-header-number novitem))) (art (car (rassq artno articleids)))) (when art (mail-header-set-number novitem art) @@ -766,11 +774,18 @@ Add an entry here when adding a new search engine.") (deffoo nnir-warp-to-article () (let* ((cur (if (> (gnus-summary-article-number) 0) (gnus-summary-article-number) - (error "This is not a real article."))) - (gnus-newsgroup-name (nnir-article-group cur)) - (backend-number (nnir-article-number cur))) - (gnus-summary-read-group-1 gnus-newsgroup-name t t gnus-summary-buffer - nil (list backend-number)))) + (error "This is not a real article"))) + (backend-article-group (nnir-article-group cur)) + (backend-article-number (nnir-article-number cur)) + (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name))) + ;; first exit from the nnir summary buffer. + (gnus-summary-exit) + ;; and if the nnir summary buffer in turn came from another + ;; summary buffer we have to clean that summary up too. + (when (eq (cdr quit-config) 'summary) + (gnus-summary-exit)) + (gnus-summary-read-group-1 backend-article-group t t nil + nil (list backend-article-number)))) (nnoo-define-skeleton nnir) @@ -798,7 +813,7 @@ ready to be added to the list of search results." ;; remove trailing slash and, for nnmaildir, cur/new/tmp (setq dirnam (substring dirnam 0 - (if (string= (gnus-group-server server) "nnmaildir") + (if (string-match "^nnmaildir:" (gnus-group-server server)) -5 -1))) ;; Set group to dirnam without any leading dots or slashes, @@ -808,7 +823,7 @@ ready to be added to the list of search results." "[/\\]" "." t))) (vector (gnus-group-full-name group server) - (if (string= (gnus-group-server server) "nnmaildir") + (if (string-match "^nnmaildir:" (gnus-group-server server)) (nnmaildir-base-name-to-article-number (substring article 0 (string-match ":" article)) group nil) @@ -839,7 +854,7 @@ details on the language and supported extensions." (lambda (group) (let (artlist) (condition-case () - (when (nnimap-possibly-change-group + (when (nnimap-change-group (gnus-group-short-name group) server) (with-current-buffer (nnimap-buffer) (message "Searching %s..." group) @@ -1065,7 +1080,8 @@ 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= (gnus-group-server server) "nnmaildir") + (article-pattern (if (string-match "^nnmaildir:" + (gnus-group-server server)) ":[0-9]+" "^[0-9]+\\(\\.[a-z0-9]+\\)?$")) score artno dirnam filenam) @@ -1262,12 +1278,12 @@ Tested with swish-e-2.0.1 on Windows NT 4.0." ;; 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 ! + (display-buffer nnir-tmp-buffer)))) ;; FIXME: Don't clear buffer ! (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" + ;; for nnml/nnfolder: "filename mailid weight" + ;; for nnimap: "group mailid weight" (goto-char (point-min)) (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$") ;; HyREX doesn't search directly in groups -- so filter out here. @@ -1307,7 +1323,8 @@ 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= (gnus-group-server server) "nnmaildir") + (let ((article-pattern (if (string-match "^nnmaildir:" + (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) artlist @@ -1380,7 +1397,8 @@ actually)." (groupspec (cdr (assq 'group query))) (prefix (nnir-read-server-parm 'nnir-notmuch-remove-prefix server)) artlist - (article-pattern (if (string= (gnus-group-server server) "nnmaildir") + (article-pattern (if (string-match "^nnmaildir:" + (gnus-group-server server)) ":[0-9]+" "^[0-9]+$")) artno dirnam filenam) @@ -1616,7 +1634,7 @@ actually)." (let* ((server (car x)) (nnir-search-engine (or (nnir-read-server-parm 'nnir-search-engine - server) + server t) (cdr (assoc (car (gnus-server-to-method server)) nnir-method-default-engines)))) @@ -1635,20 +1653,33 @@ actually)." nil))) groups)))) -(defun nnir-read-server-parm (key server) - "Returns the parameter value of key for the given server, where -server is of form 'backend:name'." +(defun nnir-read-server-parm (key server &optional not-global) + "Returns the parameter value corresponding to `key' for +`server'. If no server-specific value is found consult the global +environment unless `not-global' is non-nil." (let ((method (gnus-server-to-method server))) (cond ((and method (assq key (cddr method))) - (nth 1 (assq key (cddr method)))) - ((boundp key) (symbol-value key)) - (t nil)))) + (nth 1 (assq key (cddr method)))) + ((and (not not-global) (boundp key)) (symbol-value key)) + (t nil)))) + (defun nnir-possibly-change-server (server) (unless (and server (nnir-server-opened server)) (nnir-open-server server))) +(defun nnir-search-thread (header) + "Make an nnir group based on the thread containing the article header" + (let ((parm (list + (cons 'query + (nnimap-make-thread-query header)) + (cons 'criteria "") + (cons 'server (gnus-method-to-server + (gnus-find-method-for-group + gnus-newsgroup-name)))))) + (gnus-group-make-nnir-group nil parm) + (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header))))) ;; unused? (defun nnir-artlist-groups (artlist) @@ -1717,8 +1748,7 @@ 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)) - (when (and (boundp 'gnus-registry-install) - (eq gnus-registry-install t)) + (when (gnus-bound-and-true-p 'gnus-registry-enabled) (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)