;;; 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 <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
(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)
"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."
%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
"*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
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.
(while (not (eobp))
(let* ((novitem (funcall parsefunc))
(artno (mail-header-number novitem))
- (art (car (rassoc artno articleids))))
+ (art (car (rassq artno articleids))))
(when art
(mail-header-set-number novitem art)
(push novitem headers))
to-newsgroup ; Not respooling
(gnus-group-real-name to-newsgroup)))))
+(deffoo nnir-request-expire-articles (articles group &optional server force)
+ (if force
+ (let ((articles-by-group (nnir-categorize
+ articles nnir-article-group nnir-article-ids))
+ not-deleted)
+ (while (not (null articles-by-group))
+ (let* ((group-articles (pop articles-by-group))
+ (artgroup (car group-articles))
+ (articleids (cadr group-articles))
+ (artlist (sort (mapcar 'cdr articleids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (error "The group %s does not support article deletion" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (push (gnus-request-expire-articles
+ artlist artgroup force)
+ not-deleted)))
+ (sort (delq nil not-deleted) '<))
+ articles))
+
(deffoo nnir-warp-to-article ()
(let* ((cur (if (> (gnus-summary-article-number) 0)
(gnus-summary-article-number)
(nnir-imap-make-query
criteria qstring)))))
(mapc
- (lambda (artnum) (push (vector group artnum 100) artlist)
- (setq arts (1+ arts)))
- (and (car result)
- (delete 0 (mapcar #'string-to-number
- (cdr (assoc "SEARCH"
- (cdr result)))))))
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ 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))
- artlist))
+ (nreverse artlist)))
groups)))))
(defun nnir-imap-make-query (criteria qstring)
;; 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 (if groups
- (mapconcat
- (lambda (x)
- (format "group:%s" (gnus-group-short-name x)))
- groups " ") ""))
+ (groupspec (mapconcat
+ (lambda (x)
+ (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))) ""))
(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:
(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))
(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)
- (add-hook 'gnus-summary-article-delete-hook 'nnir-registry-action t t)
- (add-hook 'gnus-summary-article-move-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))))
projects / gnus / blobdiff