;;; nnir.el --- search mail with various search engines -*- coding: utf-8 -*-
-;; Copyright (C) 1998-2013 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2015 Free Software Foundation, Inc.
;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
;; Swish-e and Swish++ backends by:
;;; Setup:
-;; For Emacs <22.2 and XEmacs.
-(eval-and-compile
- (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))
- (unless (fboundp 'number-sequence)
- (defun number-sequence (from to)
- (let (seq (n 0) (next from))
- (while (<= next to)
- (setq seq (cons next seq)
- n (1+ n)
- next (+ from n )))
- (nreverse seq)))))
-
(require 'nnoo)
(require 'gnus-group)
(require 'message)
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.
"*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)
'vconcat
(catch 'found
(mapcar
- (lambda (group)
+ #'(lambda (group)
(let (artlist)
(condition-case ()
(when (nnimap-change-group
(goto-char (point-min))
(while (re-search-forward
- "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
+ "^\\([0-9,]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
nil t)
(setq score (match-string 3)
group (file-name-directory (match-string 4))
;;; 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"))
(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 (if (gnus-group-prefixed-p gnus-newsgroup-name)
- gnus-newsgroup-name
- (gnus-group-prefixed-name
- gnus-newsgroup-name '(nnir "nnir")))))
+ (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
(deffoo nnir-request-create-group (group &optional server args)
(message "Creating nnir group %s" group)
(let* ((group (gnus-group-prefixed-name group '(nnir "nnir")))
- (specs (assoc 'nnir-specs args))
+ (specs (assq 'nnir-specs args))
(query-spec
- (or (cdr (assoc 'nnir-query-spec specs))
+ (or (cdr (assq 'nnir-query-spec specs))
(list (cons 'query
(read-string "Query: " nil 'nnir-search-history)))))
(group-spec
- (or (cdr (assoc 'nnir-group-spec specs))
+ (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
- (or (cdr (assoc 'nnir-artlist args))
+ (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.