;;; 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)
(require 'gnus-sum)
-(eval-when-compile
- (autoload 'nnimap-buffer "nnimap")
- (autoload 'nnimap-command "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")
- (autoload 'gnus-group-topic-name "gnus-topic"))
-
-
(nnoo-declare nnir)
(nnoo-define-basics nnir)
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"
(defcustom nnir-swish++-additional-switches '()
"*A list of strings, to be given as additional arguments to swish++.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-swish++-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
+ (setq nnir-swish++-additional-switches \\='(\"-i\" \"-w\"))"
:type '(repeat (string))
:group 'nnir)
(defcustom nnir-swish-e-additional-switches '()
"*A list of strings, to be given as additional arguments to swish-e.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))
+ (setq nnir-swish-e-additional-switches \\='(\"-i\" \"-w\"))
This could be a server parameter."
:type '(repeat (string))
(defcustom nnir-hyrex-additional-switches '()
"*A list of strings, to be given as additional arguments for nnir-search.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong !
Instead, use this:
- (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
+ (setq nnir-hyrex-additional-switches \\='(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
:type '(repeat (string))
:group 'nnir)
The switches `-q', `-a', and `-s' are always used, very few other switches
make any sense in this context.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-namazu-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
+ (setq nnir-namazu-additional-switches \\='(\"-i\" \"-w\"))"
:type '(repeat (string))
:group 'nnir)
(defcustom nnir-notmuch-additional-switches '()
"*A list of strings, to be given as additional arguments to notmuch.
-Note that this should be a list. Ie, do NOT use the following:
+Note that this should be a list. I.e., do NOT use the following:
(setq nnir-notmuch-additional-switches \"-i -w\") ; wrong
Instead, use this:
- (setq nnir-notmuch-additional-switches '(\"-i\" \"-w\"))"
+ (setq nnir-notmuch-additional-switches \\='(\"-i\" \"-w\"))"
:version "24.1"
:type '(repeat (string))
:group 'nnir)
(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.
;; Gnus glue.
+(declare-function gnus-group-topic-name "gnus-topic" ())
+
(defun gnus-group-make-nnir-group (nnir-extra-parms &optional specs)
"Create an nnir group. Prompt for a search query and determine
the groups to search as follows: if called from the *Server*
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.
(deffoo nnir-request-update-mark (group article mark)
(let ((artgroup (nnir-article-group article))
(artnumber (nnir-article-number article)))
- (gnus-request-update-mark artgroup artnumber mark)))
+ (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)
;;; Search Engine Interfaces:
+(autoload 'nnimap-change-group "nnimap")
+(declare-function nnimap-buffer "nnimap" ())
+(declare-function nnimap-command "nnimap" (&rest args))
+
;; imap interface
(defun nnir-run-imap (query srv &optional groups)
"Run a search against an IMAP back-end server.
'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))
(let ((backend (car (gnus-server-to-method server))))
(nnoo-current-server-p (or backend 'nnir) server)))
+(autoload 'nnimap-make-thread-query "nnimap")
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+
(defun nnir-search-thread (header)
"Make an nnir group based on the thread containing the article
header. The current server will be searched. If the registry is
(forward-line)))))
groups))
+;; Behind gnus-registry-enabled test.
+(declare-function gnus-registry-action "gnus-registry"
+ (action data-header from &optional to method))
+
(defun nnir-registry-action (action data-header from &optional to method)
"Call `gnus-registry-action' with the original article group."
(gnus-registry-action
(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.
projects / gnus / blobdiff