;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2014 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
(eval-when-compile
(autoload 'nnimap-buffer "nnimap")
(autoload 'nnimap-command "nnimap")
- (autoload 'nnimap-possibly-change-group "nnimap")
+ (autoload 'nnimap-change-group "nnimap")
(autoload 'nnimap-make-thread-query "nnimap")
(autoload 'gnus-registry-action "gnus-registry")
(autoload 'gnus-registry-get-id-key "gnus-registry")
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
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"
(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.
Add an entry here when adding a new search engine.")
-(defcustom nnir-method-default-engines '((nnimap . imap) (nttp . gmane))
+(defcustom nnir-method-default-engines '((nnimap . imap) (nntp . gmane))
"*Alist of default search engines keyed by server method."
:version "24.1"
:group 'nnir
- :type `(repeat (cons (choice (const nnimap) (const nttp) (const nnspool)
+ :type `(repeat (cons (choice (const nnimap) (const nntp) (const nnspool)
(const nneething) (const nndir) (const nnmbox)
(const nnml) (const nnmh) (const nndraft)
(const nnfolder) (const nnmaildir))
skips all prompting."
(interactive "P")
(let* ((group-spec
- (or (cdr (assoc 'nnir-group-spec specs))
+ (or (cdr (assq 'nnir-group-spec specs))
(if (gnus-server-server-name)
(list (list (gnus-server-server-name)))
(nnir-categorize
(cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
gnus-group-server))))
(query-spec
- (or (cdr (assoc 'nnir-query-spec specs))
+ (or (cdr (assq 'nnir-query-spec specs))
(apply
'append
(list (cons 'query
(deffoo nnir-request-group (group &optional server dont-check info)
(nnir-possibly-change-group group server)
- (let ((pgroup (if (gnus-group-prefixed-p group)
- group
- (gnus-group-prefixed-name group '(nnir "nnir"))))
+ (let ((pgroup (gnus-group-guess-full-name-from-command-method group))
length)
;; Check for cached search result or run the query and cache the
;; result.
(gnus-summary-read-group-1 backend-article-group t t nil
nil (list backend-article-number))))
+(deffoo nnir-request-update-mark (group article mark)
+ (let ((artgroup (nnir-article-group article))
+ (artnumber (nnir-article-number article)))
+ (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)
+ (let (mlist)
+ (dolist (action actions)
+ (destructuring-bind (range action marks) action
+ (let ((articles-by-group (nnir-categorize
+ (gnus-uncompress-range range)
+ nnir-article-group nnir-article-number)))
+ (dolist (artgroup articles-by-group)
+ (push (list
+ (car artgroup)
+ (list (gnus-compress-sequence
+ (sort (cadr artgroup) '<)) action marks)) mlist)))))
+ (dolist (request (nnir-categorize mlist car cadr))
+ (gnus-request-set-mark (car request) (cadr request)))))
+
(deffoo nnir-request-update-info (group info &optional server)
- (let ((articles-by-group
+ (nnir-possibly-change-group group server)
+ ;; clear out all existing marks.
+ (gnus-info-set-marks info nil)
+ (gnus-info-set-read info nil)
+ (let ((group (gnus-group-guess-full-name-from-command-method group))
+ (articles-by-group
(nnir-categorize
- (number-sequence 1 (nnir-artlist-length nnir-artlist))
+ (gnus-uncompress-range (cons 1 (nnir-artlist-length nnir-artlist)))
nnir-article-group nnir-article-ids)))
(gnus-set-active group
(cons 1 (nnir-artlist-length nnir-artlist)))
info
(gnus-add-to-range
(gnus-info-read info)
- (remove nil (mapcar (lambda (art)
- (let ((num (cdr art)))
- (when (gnus-member-of-range num read)
- (car art)))) articleids))))
- (mapc (lambda (mark)
- (let ((type (car mark))
- (range (cdr mark)))
- (gnus-add-marked-articles
- group
- type
- (remove nil
- (mapcar
- (lambda (art)
- (let ((num (cdr art)))
- (when (gnus-member-of-range num range)
- (car art))))
- articleids))))) marks)))))
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (gnus-member-of-range (cdr art) read) (car art)))
+ articleids))))
+ (dolist (mark marks)
+ (destructuring-bind (type . range) mark
+ (gnus-add-marked-articles
+ group type
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (gnus-member-of-range (cdr art) range) (car art)))
+ articleids)))))))))
(deffoo nnir-close-group (group &optional server)
- (let ((pgroup (if (gnus-group-prefixed-p group)
- group
- (gnus-group-prefixed-name group '(nnir "nnir")))))
+ (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))
(setq nnir-artlist nil)
;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir"))
;; gnus-opened-servers))))
-(nnoo-define-skeleton nnir)
+
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
'vconcat
(catch 'found
(mapcar
- (lambda (group)
+ #'(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)
;;; Util Code:
+(defun gnus-nnir-group-p (group)
+ "Say whether GROUP is nnir or not."
+ (if (gnus-group-prefixed-p group)
+ (eq 'nnir (car (gnus-find-method-for-group group)))
+ (and group (string-match "^nnir" group))))
+
(defun nnir-read-parms (nnir-search-engine)
"Reads additional search parameters according to `nnir-engines'."
(let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
(defun nnir-possibly-change-group (group &optional server)
(or (not server) (nnir-server-opened server) (nnir-open-server server))
- (when (and group (string-match "\\`nnir" group))
+ (when (gnus-nnir-group-p group)
(setq nnir-artlist (gnus-group-get-parameter
(gnus-group-prefixed-name
(gnus-group-short-name group) '(nnir "nnir"))
(add-hook 'gnus-summary-article-expire-hook 'nnir-registry-action t t))))
+(defun gnus-summary-create-nnir-group ()
+ (interactive)
+ (or (nnir-server-opened "") (nnir-open-server "nnir"))
+ (let ((name (gnus-read-group "Group name: "))
+ (method '(nnir ""))
+ (pgroup
+ (gnus-group-guess-full-name-from-command-method gnus-newsgroup-name)))
+ (with-current-buffer gnus-group-buffer
+ (gnus-group-make-group
+ name method nil
+ (gnus-group-find-parameter pgroup)))))
+
(deffoo nnir-request-create-group (group &optional server args)
(message "Creating nnir group %s" group)
- (let ((group (gnus-group-prefixed-name group '(nnir "nnir")))
- (query-spec
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history))))
- (group-spec (list (list (read-string "Server: " nil nil)))))
- (gnus-group-set-parameter
- group 'nnir-specs
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))
+ (let* ((group (gnus-group-prefixed-name group '(nnir "nnir")))
+ (specs (assq 'nnir-specs args))
+ (query-spec
+ (or (cdr (assq 'nnir-query-spec specs))
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))))
+ (group-spec
+ (or (cdr (assq 'nnir-group-spec specs))
+ (list (list (read-string "Server: " nil nil)))))
+ (nnir-specs (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec))))
+ (gnus-group-set-parameter group 'nnir-specs nnir-specs)
(gnus-group-set-parameter
group 'nnir-artlist
- (setq nnir-artlist
- (nnir-run-query
- (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))))
+ (or (cdr (assq 'nnir-artlist args))
+ (nnir-run-query nnir-specs)))
(nnir-request-update-info group (gnus-get-info group)))
t)
t)
(deffoo nnir-request-scan (group method)
- (if group
- (let ((pgroup (if (gnus-group-prefixed-p group)
- group
- (gnus-group-prefixed-name group '(nnir "nnir")))))
- (gnus-group-set-parameter
- pgroup 'nnir-artlist
- (setq nnir-artlist
- (nnir-run-query
- (gnus-group-get-parameter pgroup 'nnir-specs t))))
- (nnir-request-update-info pgroup (gnus-get-info pgroup)))
- t))
+ t)
+(deffoo nnir-request-close ()
+ t)
+
+(nnoo-define-skeleton nnir)
;; The end.
(provide 'nnir)