[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/gnus-select 1633130 1/3: Initial landing of gnus n
|
From: |
Andrew G Cohen |
|
Subject: |
[Emacs-diffs] feature/gnus-select 1633130 1/3: Initial landing of gnus nnselect backend |
|
Date: |
Sun, 23 Apr 2017 21:38:12 -0400 (EDT) |
branch: feature/gnus-select
commit 163313049bd3be1985faeeef38f0e4a661d9e034
Author: Andrew G Cohen <address@hidden>
Commit: Andrew G Cohen <address@hidden>
Initial landing of gnus nnselect backend
This is a new virtual backend for gnus, wherein any collection of
articles can be viewed as a gnus group (permanent or ephemeral).
* lisp/gnus/nnselect.el: New file.
* lisp/gnus/nnir.el: Remove the nnir backend but leave the search
functions.
* lisp/gnus/nnimap.el: Replace nnir backend related items with
nnselect.
(gnus-refer-thread-use-search): Renamed from gnus-refer-thread-use-nnir
(nnselect-search-thread): New function.
(nnimap-request-thread): Use it.
* lisp/gnus/gnus-group.el (gnus-group-make-search-group): New function
replacing gnus-group-make-nnir-group.
* lisp/gnus/gnus-msg.el: Replace nnir backend related items with
nnselect.
(gnus-setup-message): Pass virtual group article number to
gnus-inews-add-send-actions.
* lisp/gnus/gnus-registry.el (gnus-registry-action): Find the
originating article group when in an nnselect group.
(gnus-registry-ignore-group-p): Ignore virtual groups.
* lisp/gnus/gnus-srvr.el (gnus-group-make-search-group): Use new
function.
* lisp/gnus/gnus-sum.el (nnselect-article-): Use new nnselect backend
functions.
(gnus-summary-line-format-alist): Rework specs specific to nnselect
groups.
(nnselect-artlist):
(gnus-summary-local-variables): A new group-local variable.
---
lisp/gnus/gnus-group.el | 6 +-
lisp/gnus/gnus-msg.el | 23 +-
lisp/gnus/gnus-registry.el | 11 +-
lisp/gnus/gnus-srvr.el | 4 +-
lisp/gnus/gnus-sum.el | 41 ++-
lisp/gnus/gnus.el | 2 +-
lisp/gnus/nnimap.el | 12 +-
lisp/gnus/nnir.el | 716 +++++------------------------------------
lisp/gnus/nnselect.el | 774 +++++++++++++++++++++++++++++++++++++++++++++
9 files changed, 910 insertions(+), 679 deletions(-)
diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el
index 8a061b7..9fcb3c1 100644
--- a/lisp/gnus/gnus-group.el
+++ b/lisp/gnus/gnus-group.el
@@ -49,7 +49,7 @@
(autoload 'gnus-agent-total-fetched-for "gnus-agent")
(autoload 'gnus-cache-total-fetched-for "gnus-cache")
-(autoload 'gnus-group-make-nnir-group "nnir")
+(autoload 'gnus-group-make-search-group "nnselect")
(autoload 'gnus-cloud-upload-all-data "gnus-cloud")
(autoload 'gnus-cloud-download-all-data "gnus-cloud")
@@ -671,7 +671,7 @@ simple manner."
"D" gnus-group-enter-directory
"f" gnus-group-make-doc-group
"w" gnus-group-make-web-group
- "G" gnus-group-make-nnir-group
+ "G" gnus-group-make-search-group
"M" gnus-group-read-ephemeral-group
"r" gnus-group-rename-group
"R" gnus-group-make-rss-group
@@ -917,7 +917,7 @@ simple manner."
["Add the help group" gnus-group-make-help-group t]
["Make a doc group..." gnus-group-make-doc-group t]
["Make a web group..." gnus-group-make-web-group t]
- ["Make a search group..." gnus-group-make-nnir-group t]
+ ["Make a search group..." gnus-group-make-search-group t]
["Make a virtual group..." gnus-group-make-empty-virtual t]
["Add a group to a virtual..." gnus-group-add-to-virtual t]
["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el
index 85969ed..c06015d 100644
--- a/lisp/gnus/gnus-msg.el
+++ b/lisp/gnus/gnus-msg.el
@@ -414,10 +414,9 @@ Thank you for your help in stamping out bugs.
(gnus-inews-make-draft-meta-information
,(gnus-group-decoded-name gnus-newsgroup-name) ',articles)))
-(autoload 'nnir-article-number "nnir" nil nil 'macro)
-(autoload 'nnir-article-group "nnir" nil nil 'macro)
-(autoload 'gnus-nnir-group-p "nnir")
-
+(autoload 'nnselect-article-number "nnselect" nil nil 'macro)
+(autoload 'nnselect-article-group "nnselect" nil nil 'macro)
+(autoload 'gnus-nnselect-group-p "nnselect")
(defvar gnus-article-reply nil)
(defmacro gnus-setup-message (config &rest forms)
@@ -425,21 +424,23 @@ Thank you for your help in stamping out bugs.
(winconf-name (make-symbol "gnus-setup-message-winconf-name"))
(buffer (make-symbol "gnus-setup-message-buffer"))
(article (make-symbol "gnus-setup-message-article"))
+ (oarticle (make-symbol "gnus-setup-message-oarticle"))
(yanked (make-symbol "gnus-setup-yanked-articles"))
(group (make-symbol "gnus-setup-message-group")))
`(let ((,winconf (current-window-configuration))
(,winconf-name gnus-current-window-configuration)
(,buffer (buffer-name (current-buffer)))
- (,article (if (and (gnus-nnir-group-p gnus-newsgroup-name)
+ (,article (if (and (gnus-nnselect-group-p gnus-newsgroup-name)
gnus-article-reply)
- (nnir-article-number (or (car-safe gnus-article-reply)
- gnus-article-reply))
+ (nnselect-article-number
+ (or (car-safe gnus-article-reply) gnus-article-reply))
gnus-article-reply))
+ (,oarticle gnus-article-reply)
(,yanked gnus-article-yanked-articles)
- (,group (if (and (gnus-nnir-group-p gnus-newsgroup-name)
+ (,group (if (and (gnus-nnselect-group-p gnus-newsgroup-name)
gnus-article-reply)
- (nnir-article-group (or (car-safe gnus-article-reply)
- gnus-article-reply))
+ (nnselect-article-group
+ (or (car-safe gnus-article-reply) gnus-article-reply))
gnus-newsgroup-name))
(message-header-setup-hook
(copy-sequence message-header-setup-hook))
@@ -481,7 +482,7 @@ Thank you for your help in stamping out bugs.
(unwind-protect
(progn
,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
+ (gnus-inews-add-send-actions ,winconf ,buffer ,oarticle ,config
,yanked ,winconf-name)
(setq gnus-message-buffer (current-buffer))
(set (make-local-variable 'gnus-message-group-art)
diff --git a/lisp/gnus/gnus-registry.el b/lisp/gnus/gnus-registry.el
index 51f6459..47b6873 100644
--- a/lisp/gnus/gnus-registry.el
+++ b/lisp/gnus/gnus-registry.el
@@ -390,7 +390,10 @@ This is not required after changing
`gnus-registry-cache-file'."
(or (cdr-safe (assq 'To extra)) "")))
(sender (nth 0 (gnus-registry-extract-addresses
(mail-header-from data-header))))
- (from (gnus-group-guess-full-name-from-command-method from))
+ (from (gnus-group-guess-full-name-from-command-method
+ (if (gnus-nnselect-group-p from)
+ (nnselect-article-group (mail-header-number data-header))
+ from)))
(to (if to (gnus-group-guess-full-name-from-command-method to) nil)))
(gnus-message 7 "Gnus registry: article %s %s from %s to %s"
id (if method "respooling" "going") from to)
@@ -737,7 +740,7 @@ Consults `gnus-registry-unfollowed-groups' and
Consults `gnus-registry-ignored-groups' and
`nnmail-split-fancy-with-parent-ignore-groups'."
(and group
- (or (gnus-grep-in-list
+ (or (gnus-virtual-group-p group) (gnus-grep-in-list
group
(delq nil (mapcar (lambda (g)
(cond
@@ -1175,7 +1178,7 @@ is `ask', ask the user; or if `gnus-registry-install' is
non-nil, enable it."
(gnus-registry-initialize)))
gnus-registry-enabled)
-;; largely based on nnir-warp-to-article
+;; largely based on nnselect-warp-to-article
(defun gnus-try-warping-via-registry ()
"Try to warp via the registry.
This will be done via the current article's source group based on
@@ -1199,7 +1202,7 @@ data stored in the registry."
(gnus-ephemeral-group-p group) ;; any ephemeral group
(memq (car (gnus-find-method-for-group group))
;; Specific methods; this list may need to expand.
- '(nnir)))
+ '(nnselect)))
;; remember that we've seen this group already
(push group seen-groups)
diff --git a/lisp/gnus/gnus-srvr.el b/lisp/gnus/gnus-srvr.el
index bed5993..24e5b1c 100644
--- a/lisp/gnus/gnus-srvr.el
+++ b/lisp/gnus/gnus-srvr.el
@@ -34,7 +34,7 @@
(require 'gnus-range)
(require 'gnus-cloud)
-(autoload 'gnus-group-make-nnir-group "nnir")
+(autoload 'gnus-group-make-search-group "nnselect")
(defcustom gnus-server-mode-hook nil
"Hook run in `gnus-server-mode' buffers."
@@ -184,7 +184,7 @@ If nil, a faster, but more primitive, buffer is used
instead."
"g" gnus-server-regenerate-server
- "G" gnus-group-make-nnir-group
+ "G" gnus-group-make-search-group
"z" gnus-server-compact-server
diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el
index 183cd46..3cb4784 100644
--- a/lisp/gnus/gnus-sum.el
+++ b/lisp/gnus/gnus-sum.el
@@ -52,8 +52,8 @@
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
-(autoload 'nnir-article-rsv "nnir" nil nil 'macro)
-(autoload 'nnir-article-group "nnir" nil nil 'macro)
+(autoload 'nnselect-article-rsv "nnselect" nil nil 'macro)
+(autoload 'nnselect-article-group "nnselect" nil nil 'macro)
(defcustom gnus-kill-summary-on-exit t
"If non-nil, kill the summary buffer when you exit from it.
@@ -111,8 +111,8 @@ If t, fetch all the available old headers."
:type '(choice number
(sexp :menu-tag "other" t)))
-(defcustom gnus-refer-thread-use-nnir nil
- "Use nnir to search an entire server when referring threads. A
+(defcustom gnus-refer-thread-use-search nil
+ "Search an entire server when referring threads. A
nil value will only search for thread-related articles in the
current group."
:version "24.1"
@@ -1388,13 +1388,16 @@ the normal Gnus MIME machinery."
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
- (?Z (or (nnir-article-rsv (mail-header-number gnus-tmp-header))
- 0) ?d)
- (?G (or (nnir-article-group (mail-header-number gnus-tmp-header))
- "") ?s)
- (?g (or (gnus-group-short-name
- (nnir-article-group (mail-header-number gnus-tmp-header)))
- "") ?s)
+ (?Z (if (gnus-nnselect-group-p gnus-newsgroup-name)
+ (or (nnselect-article-rsv (mail-header-number gnus-tmp-header))
+ 0) 0) ?d)
+ (?G (if (gnus-nnselect-group-p gnus-newsgroup-name)
+ (or (nnselect-article-group (mail-header-number gnus-tmp-header))
+ "") "") ?s)
+ (?g (if (gnus-nnselect-group-p gnus-newsgroup-name)
+ (or (gnus-group-short-name
+ (nnselect-article-group (mail-header-number gnus-tmp-header)))
+ "") "") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
@@ -1568,6 +1571,8 @@ This list will always be a subset of
gnus-newsgroup-undownloaded.")
(defvar gnus-newsgroup-sparse nil)
+(defvar nnselect-artlist nil)
+
(defvar gnus-current-article nil)
(defvar gnus-article-current nil)
(defvar gnus-current-headers nil)
@@ -1602,6 +1607,8 @@ This list will always be a subset of
gnus-newsgroup-undownloaded.")
gnus-newsgroup-undownloaded
gnus-newsgroup-unsendable
+ nnselect-artlist
+
gnus-newsgroup-begin gnus-newsgroup-end
gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
gnus-newsgroup-last-folder gnus-newsgroup-last-file
@@ -9007,9 +9014,9 @@ Return the number of articles fetched."
(defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread. For backends that
know how to search for threads (currently only 'nnimap) a
-non-numeric prefix arg will use nnir to search the entire
+non-numeric prefix arg will search the entire
server; without a prefix arg only the current group is
-searched. If the variable `gnus-refer-thread-use-nnir' is
+searched. If the variable `gnus-refer-thread-use-search' is
non-nil the prefix arg has the reverse meaning. If no
backend-specific 'request-thread function is available fetch
LIMIT (the numerical prefix) old headers. If LIMIT is
@@ -9021,9 +9028,9 @@ non-numeric or nil fetch the number specified by the
(gnus-inhibit-demon t)
(gnus-summary-ignore-duplicates t)
(gnus-read-all-available-headers t)
- (gnus-refer-thread-use-nnir
+ (gnus-refer-thread-use-search
(if (and (not (null limit)) (listp limit))
- (not gnus-refer-thread-use-nnir) gnus-refer-thread-use-nnir))
+ (not gnus-refer-thread-use-search) gnus-refer-thread-use-search))
(new-headers
(if (gnus-check-backend-function
'request-thread gnus-newsgroup-name)
@@ -9162,9 +9169,9 @@ non-numeric or nil fetch the number specified by the
(dolist (method gnus-refer-article-method)
(push (if (eq 'current method)
gnus-current-select-method
- (if (eq 'nnir (car method))
+ (if (eq 'nnselect (car method))
(list
- 'nnir
+ 'nnselect
(or (cadr method)
(gnus-method-to-server gnus-current-select-method)))
method))
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index d3edcd0..807632f 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1868,7 +1868,7 @@ total number of articles in the group.")
:variable-default (mapcar
(lambda (g) (list g t))
'("delayed$" "drafts$" "queue$" "INBOX$"
- "^nnmairix:" "^nnir:" "archive"))
+ "^nnmairix:" "^nnselect:" "archive"))
:variable-document
"Groups in which the registry should be turned off."
:variable-group gnus-registry
diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el
index 2943c8d..7a51f7f 100644
--- a/lisp/gnus/nnimap.el
+++ b/lisp/gnus/nnimap.el
@@ -1797,17 +1797,17 @@ If LIMIT, first try to limit the search to the N last
articles."
(setq nnimap-status-string "Read-only server")
nil)
-(defvar gnus-refer-thread-use-nnir) ;; gnus-sum.el
+(defvar gnus-refer-thread-use-search) ;; gnus-sum.el
(declare-function gnus-fetch-headers "gnus-sum"
(articles &optional limit force-new dependencies))
-(autoload 'nnir-search-thread "nnir")
+(autoload 'nnselect-search-thread "nnselect")
(deffoo nnimap-request-thread (header &optional group server)
(when group
(setq group (nnimap-decode-gnus-group group)))
- (if gnus-refer-thread-use-nnir
- (nnir-search-thread header)
+ (if gnus-refer-thread-use-search
+ (nnselect-search-thread header)
(when (nnimap-change-group group server)
(let* ((cmd (nnimap-make-thread-query header))
(result (with-current-buffer (nnimap-buffer)
@@ -2219,11 +2219,11 @@ Return the server's response to the SELECT or EXAMINE
command."
"")))
(value
(format
- "(OR HEADER REFERENCES %S HEADER Message-Id %S)"
+ "(OR HEADER References %S HEADER Message-Id %S)"
id id)))
(dolist (refid refs value)
(setq value (format
- "(OR (OR HEADER Message-Id %S HEADER REFERENCES %S) %s)"
+ "(OR (OR HEADER Message-Id %S HEADER References %S) %s)"
refid refid value)))))
diff --git a/lisp/gnus/nnir.el b/lisp/gnus/nnir.el
index 9640f2c..35ec292 100644
--- a/lisp/gnus/nnir.el
+++ b/lisp/gnus/nnir.el
@@ -10,6 +10,7 @@
;; IMAP search improved by Daniel Pittman <address@hidden>.
;; nnmaildir support for Swish++ and Namazu backends by:
;; Justus Piater <Justus <at> Piater.name>
+;; Mostly rewritten by Andrew Cohen <address@hidden> from 2010
;; Keywords: news mail searching ir
;; This file is part of GNU Emacs.
@@ -29,17 +30,8 @@
;;; Commentary:
-;; What does it do? Well, it allows you to search your mail using
-;; some search engine (imap, namazu, swish-e, gmane and others -- see
-;; later) by typing `G G' in the Group buffer. You will then get a
-;; buffer which shows all articles matching the query, sorted by
-;; Retrieval Status Value (score).
-
-;; When looking at the retrieval result (in the Summary buffer) you
-;; can type `A W' (aka M-x gnus-warp-to-article RET) on an article. You
-;; will be warped into the group this article came from. Typing `A T'
-;; (aka M-x gnus-summary-refer-thread RET) will warp to the group and
-;; also show the thread this article is part of.
+;; What does it do? Well, it searches your mail using some search
+;; engine (imap, namazu, swish-e, gmane and others -- see later).
;; The Lisp setup may involve setting a few variables and setting up the
;; search engine. You can define the variables in the server definition
@@ -53,6 +45,45 @@
;; an alist, type `C-h v nnir-engines RET' for more information; this
;; includes examples for setting `nnir-search-engine', too.)
+;; The entry to searching is the single function `nnir-run-query',
+;; which dispatches the search to the proper search function. The
+;; argument of `nnir-run-query' is an alist with two keys:
+;; 'nnir-query-spec and 'nnir-group-spec. The value for
+;; 'nnir-query-spec is an alist. The only required key/value pair is
+;; (query . "query") specifying the search string to pass to the query
+;; engine. Individual engines may have other elements. The value of
+;; 'nnir-group-spec is a list with the specification of the
+;; groups/servers to search. The format of the 'nnir-group-spec is
+;; (("server1" ("group11" "group12")) ("server2" ("group21"
+;; "group22"))). If any of the group lists is absent then all groups
+;; on that server are searched.
+
+;; The output of `nnir-run-query' is a vector, each element of which
+;; should in turn be a three-element vector with the form: [fully
+;; prefixed group-name of the article; the article number; the
+;; Retrieval Status Value (RSV)] as returned from the search engine.
+;; An RSV is the score assigned to the document by the search engine.
+;; For Boolean search engines, the RSV is always 1000 (or 1 or 100, or
+;; whatever you like).
+
+;; A vector of this form is used by the nnselect backend to create
+;; virtual groups. So nnir-run-query is a suitable function to use in
+;; nnselect groups.
+
+;; The default sorting order of articles in an nnselect summary buffer
+;; is based on the order of the articles in the above mentioned
+;; vector, so that's where you can do the sorting you'd like. Maybe
+;; it would be nice to have a way of displaying the search result
+;; sorted differently?
+
+;; So what do you need to do when you want to add another search
+;; engine? You write a function that executes the query. Temporary
+;; data from the search engine can be put in `nnir-tmp-buffer'. This
+;; function should return the list of articles as a vector, as
+;; described above. Then, you need to register this backend in
+;; `nnir-engines'. Then, users can choose the backend by setting
+;; `nnir-search-engine' as a server variable.
+
;; If you use one of the local indices (namazu, find-grep, swish) you
;; must also set up a search engine backend.
@@ -121,72 +152,16 @@
;; | (nnml-active-file "~/News/cache/active"))
;; `----
-;; Developer information:
-
-;; I have tried to make the code expandable. Basically, it is divided
-;; into two layers. The upper layer is somewhat like the `nnvirtual'
-;; backend: given a specification of what articles to show from
-;; another backend, it creates a group containing exactly those
-;; articles. The lower layer issues a query to a search engine and
-;; produces such a specification of what articles to show from the
-;; other backend.
-
-;; The interface between the two layers consists of the single
-;; function `nnir-run-query', which dispatches the search to the
-;; proper search function. The argument of `nnir-run-query' is an
-;; alist with two keys: 'nnir-query-spec and 'nnir-group-spec. The
-;; value for 'nnir-query-spec is an alist. The only required key/value
-;; pair is (query . "query") specifying the search string to pass to
-;; the query engine. Individual engines may have other elements. The
-;; value of 'nnir-group-spec is a list with the specification of the
-;; groups/servers to search. The format of the 'nnir-group-spec is
-;; (("server1" ("group11" "group12")) ("server2" ("group21"
-;; "group22"))). If any of the group lists is absent then all groups
-;; on that server are searched.
-
-;; The output of `nnir-run-query' is supposed to be a vector, each
-;; element of which should in turn be a three-element vector. The
-;; first element should be full group name of the article, the second
-;; element should be the article number, and the third element should
-;; be the Retrieval Status Value (RSV) as returned from the search
-;; engine. An RSV is the score assigned to the document by the search
-;; engine. For Boolean search engines, the RSV is always 1000 (or 1
-;; or 100, or whatever you like).
-
-;; The sorting order of the articles in the summary buffer created by
-;; nnir is based on the order of the articles in the above mentioned
-;; vector, so that's where you can do the sorting you'd like. Maybe
-;; it would be nice to have a way of displaying the search result
-;; sorted differently?
-
-;; So what do you need to do when you want to add another search
-;; engine? You write a function that executes the query. Temporary
-;; data from the search engine can be put in `nnir-tmp-buffer'. This
-;; function should return the list of articles as a vector, as
-;; described above. Then, you need to register this backend in
-;; `nnir-engines'. Then, users can choose the backend by setting
-;; `nnir-search-engine' as a server variable.
;;; Code:
;;; Setup:
-(require 'nnoo)
-(require 'gnus-group)
-(require 'message)
-(require 'gnus-util)
(eval-when-compile (require 'cl-lib))
;;; Internal Variables:
-(defvar nnir-memo-query nil
- "Internal: stores current query.")
-
-(defvar nnir-memo-server nil
- "Internal: stores current server.")
-
-(defvar nnir-artlist nil
- "Internal: stores search result.")
+(defvar gnus-inhibit-demon)
(defvar nnir-search-history ()
"Internal: the history for querying search options in nnir")
@@ -203,7 +178,8 @@
("to" . "TO")
("from" . "FROM")
("body" . "BODY")
- ("imap" . ""))
+ ("imap" . "")
+ ("gmail" . "X-GM-RAW"))
"Mapping from user readable keys to IMAP search items for use in nnir")
(defvar nnir-imap-search-other "HEADER %S"
@@ -216,17 +192,6 @@
;;; Helper macros
-;; Data type article list.
-
-(defmacro nnir-artlist-length (artlist)
- "Returns number of articles in artlist."
- `(length ,artlist))
-
-(defmacro nnir-artlist-article (artlist n)
- "Returns from ARTLIST the Nth artitem (counting starting at 1)."
- `(when (> ,n 0)
- (elt ,artlist (1- ,n))))
-
(defmacro nnir-artitem-group (artitem)
"Returns the group from the ARTITEM."
`(elt ,artitem 0))
@@ -239,52 +204,6 @@
"Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
`(elt ,artitem 2))
-(defmacro nnir-article-group (article)
- "Returns the group for ARTICLE"
- `(nnir-artitem-group (nnir-artlist-article nnir-artlist ,article)))
-
-(defmacro nnir-article-number (article)
- "Returns the number for ARTICLE"
- `(nnir-artitem-number (nnir-artlist-article nnir-artlist ,article)))
-
-(defmacro nnir-article-rsv (article)
- "Returns the rsv for ARTICLE"
- `(nnir-artitem-rsv (nnir-artlist-article nnir-artlist ,article)))
-
-(defsubst nnir-article-ids (article)
- "Returns the pair `(nnir id . real id)' of ARTICLE"
- (cons article (nnir-article-number article)))
-
-(defmacro nnir-categorize (sequence keyfunc &optional valuefunc)
- "Sorts a sequence into categories and returns a list of the form
-`((key1 (element11 element12)) (key2 (element21 element22))'.
-The category key for a member of the sequence is obtained
-as `(keyfunc member)' and the corresponding element is just
-`member'. If `valuefunc' is non-nil, the element of the list
-is `(valuefunc member)'."
- `(unless (null ,sequence)
- (let (value)
- (mapc
- (lambda (member)
- (let ((y (,keyfunc member))
- (x ,(if valuefunc
- `(,valuefunc member)
- 'member)))
- (if (assoc y value)
- (push x (cadr (assoc y value)))
- (push (list y (list x)) value))))
- ,sequence)
- value)))
-
-;;; Finish setup:
-
-(require 'gnus-sum)
-
-(nnoo-declare nnir)
-(nnoo-define-basics nnir)
-
-(gnus-declare-backend "nnir" 'mail 'virtual)
-
;;; User Customizable Variables:
@@ -299,32 +218,6 @@ is `(valuefunc member)'."
:type '(regexp)
:group 'nnir)
-(defcustom nnir-summary-line-format nil
- "The format specification of the lines in an nnir summary buffer.
-
-All the items from `gnus-summary-line-format' are available, along
-with three items unique to nnir summary buffers:
-
-%Z Search retrieval score value (integer)
-%G Article original full group name (string)
-%g Article original short group name (string)
-
-If nil this will use `gnus-summary-line-format'."
- :version "24.1"
- :type '(choice (const :tag "gnus-summary-line-format" nil) string)
- :group 'nnir)
-
-(defcustom nnir-retrieve-headers-override-function nil
- "If non-nil, a function that accepts an article list and group
-and populates the `nntp-server-buffer' with the retrieved
-headers. Must return either 'nov or 'headers indicating the
-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 '(choice (const :tag "gnus-retrieve-headers" nil) function)
- :group 'nnir)
(defcustom nnir-imap-default-search-key "whole message"
"The default IMAP search key for an nnir search. Must be one of
@@ -518,7 +411,7 @@ that it is for notmuch, not Namazu."
:type '(regexp)
:group 'nnir)
-;;; Developer Extension Variable:
+;;; Extension Variable:
(defvar nnir-engines
`((imap nnir-run-imap
@@ -573,332 +466,6 @@ Add an entry here when adding a new search engine.")
,@(mapcar (lambda (elem) (list 'const (car elem)))
nnir-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*
-buffer search all groups belonging to the server on the current
-line; if called from the *Group* buffer search any marked groups,
-or the group on the current line, or all the groups under the
-current topic. Calling with a prefix-arg prompts for additional
-search-engine specific constraints. A non-nil `specs' arg must be
-an alist with `nnir-query-spec' and `nnir-group-spec' keys, and
-skips all prompting."
- (interactive "P")
- (let* ((group-spec
- (or (cdr (assq 'nnir-group-spec specs))
- (if (gnus-server-server-name)
- (list (list (gnus-server-server-name)))
- (nnir-categorize
- (or gnus-group-marked
- (if (gnus-group-group-name)
- (list (gnus-group-group-name))
- (cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
- gnus-group-server))))
- (query-spec
- (or (cdr (assq 'nnir-query-spec specs))
- (apply
- 'append
- (list (cons 'query
- (read-string "Query: " nil 'nnir-search-history)))
- (when nnir-extra-parms
- (mapcar
- (lambda (x)
- (nnir-read-parms (nnir-server-to-search-engine (car x))))
- group-spec))))))
- (gnus-group-read-ephemeral-group
- (concat "nnir-" (message-unique-id))
- (list 'nnir "nnir")
- nil
-; (cons (current-buffer) gnus-current-window-configuration)
- nil
- nil nil
- (list
- (cons 'nnir-specs (list (cons 'nnir-query-spec query-spec)
- (cons 'nnir-group-spec group-spec)))
- (cons 'nnir-artlist nil)))))
-
-(defun gnus-summary-make-nnir-group (nnir-extra-parms)
- "Search a group from the summary buffer."
- (interactive "P")
- (gnus-warp-to-article)
- (let ((spec
- (list
- (cons 'nnir-group-spec
- (list (list
- (gnus-group-server gnus-newsgroup-name)
- (list gnus-newsgroup-name)))))))
- (gnus-group-make-nnir-group nnir-extra-parms spec)))
-
-
-;; Gnus backend interface functions.
-
-(deffoo nnir-open-server (server &optional definitions)
- ;; Just set the server variables appropriately.
- (let ((backend (car (gnus-server-to-method server))))
- (if backend
- (nnoo-change-server backend server definitions)
- (add-hook 'gnus-summary-mode-hook 'nnir-mode)
- (nnoo-change-server 'nnir server definitions))))
-
-(deffoo nnir-request-group (group &optional server dont-check info)
- (nnir-possibly-change-group group server)
- (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.
- (unless (and nnir-artlist dont-check)
- (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)))
- (with-current-buffer nntp-server-buffer
- (if (zerop (setq length (nnir-artlist-length nnir-artlist)))
- (progn
- (nnir-close-group group)
- (nnheader-report 'nnir "Search produced empty results."))
- (nnheader-insert "211 %d %d %d %s\n"
- length ; total #
- 1 ; first #
- length ; last #
- group)))) ; group name
- nnir-artlist)
-
-(deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
- (with-current-buffer nntp-server-buffer
- (let ((gnus-inhibit-demon t)
- (articles-by-group (nnir-categorize
- articles nnir-article-group nnir-article-ids))
- headers)
- (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) '<))
- (server (gnus-group-server artgroup))
- (gnus-override-method (gnus-server-to-method server))
- parsefunc)
- ;; (nnir-possibly-change-group nil server)
- (erase-buffer)
- (pcase (setq gnus-headers-retrieved-by
- (or
- (and
- nnir-retrieve-headers-override-function
- (funcall nnir-retrieve-headers-override-function
- artlist artgroup))
- (gnus-retrieve-headers artlist artgroup nil)))
- ('nov
- (setq parsefunc 'nnheader-parse-nov))
- ('headers
- (setq parsefunc 'nnheader-parse-head))
- (_ (error "Unknown header type %s while requesting articles \
- of group %s" gnus-headers-retrieved-by artgroup)))
- (goto-char (point-min))
- (while (not (eobp))
- (let* ((novitem (funcall parsefunc))
- (artno (and novitem
- (mail-header-number novitem)))
- (art (car (rassq artno articleids))))
- (when art
- (mail-header-set-number novitem art)
- (push novitem headers))
- (forward-line 1)))))
- (setq headers
- (sort headers
- (lambda (x y)
- (< (mail-header-number x) (mail-header-number y)))))
- (erase-buffer)
- (mapc 'nnheader-insert-nov headers)
- 'nov)))
-
-(deffoo nnir-request-article (article &optional group server to-buffer)
- (nnir-possibly-change-group group server)
- (if (and (stringp article)
- (not (eq 'nnimap (car (gnus-server-to-method server)))))
- (nnheader-report
- 'nnir
- "nnir-request-article only groks message ids for nnimap servers: %s"
- server)
- (save-excursion
- (let ((article article)
- query)
- (when (stringp article)
- (setq gnus-override-method (gnus-server-to-method server))
- (setq query
- (list
- (cons 'query (format "HEADER Message-ID %s" article))
- (cons 'criteria "")
- (cons 'shortcut t)))
- (unless (and nnir-artlist (equal query nnir-memo-query)
- (equal server nnir-memo-server))
- (setq nnir-artlist (nnir-run-imap query server)
- nnir-memo-query query
- nnir-memo-server server))
- (setq article 1))
- (unless (zerop (nnir-artlist-length nnir-artlist))
- (let ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article)))
- (message "Requesting article %d from group %s"
- artno artfullgroup)
- (if to-buffer
- (with-current-buffer to-buffer
- (let ((gnus-article-decode-hook nil))
- (gnus-request-article-this-buffer artno artfullgroup)))
- (gnus-request-article artno artfullgroup))
- (cons artfullgroup artno)))))))
-
-(deffoo nnir-request-move-article (article group server accept-form
- &optional last internal-move-group)
- (nnir-possibly-change-group group server)
- (let* ((artfullgroup (nnir-article-group article))
- (artno (nnir-article-number article))
- (to-newsgroup (nth 1 accept-form))
- (to-method (gnus-find-method-for-group to-newsgroup))
- (from-method (gnus-find-method-for-group artfullgroup))
- (move-is-internal (gnus-server-equal from-method to-method)))
- (unless (gnus-check-backend-function
- 'request-move-article artfullgroup)
- (error "The group %s does not support article moving" artfullgroup))
- (gnus-request-move-article
- artno
- artfullgroup
- (nth 1 from-method)
- accept-form
- last
- (and move-is-internal
- to-newsgroup ; Not respooling
- (gnus-group-real-name to-newsgroup)))))
-
-(deffoo nnir-request-expire-articles (articles group &optional server force)
- (nnir-possibly-change-group group server)
- (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 ()
- (nnir-possibly-change-group gnus-newsgroup-name)
- (let* ((cur (if (> (gnus-summary-article-number) 0)
- (gnus-summary-article-number)
- (error "Can't warp to a pseudo-article")))
- (backend-article-group (nnir-article-group cur))
- (backend-article-number (nnir-article-number cur))
- (quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)))
-
- ;; what should we do here? we could leave all the buffers around
- ;; and assume that we have to exit from them one by one. or we can
- ;; try to clean up directly
-
- ;;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 (not (eq (cdr quit-config) 'group))
-; (gnus-summary-exit))
- (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)))
- (or (and artgroup
- artnumber
- (gnus-request-update-mark artgroup artnumber mark))
- mark)))
-
-(deffoo nnir-request-set-mark (group actions &optional server)
- (nnir-possibly-change-group group server)
- (let (mlist)
- (dolist (action actions)
- (cl-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)
- (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
- (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)))
- (while (not (null articles-by-group))
- (let* ((group-articles (pop articles-by-group))
- (articleids (reverse (cadr group-articles)))
- (group-info (gnus-get-info (car group-articles)))
- (marks (gnus-info-marks group-info))
- (read (gnus-info-read group-info)))
- (gnus-info-set-read
- info
- (gnus-add-to-range
- (gnus-info-read info)
- (delq nil
- (mapcar
- #'(lambda (art)
- (when (gnus-member-of-range (cdr art) read) (car art)))
- articleids))))
- (dolist (mark marks)
- (cl-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)
- (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)
- (when (gnus-ephemeral-group-p pgroup)
- (gnus-kill-ephemeral-group pgroup)
- (setq gnus-ephemeral-servers
- (delq (assq 'nnir gnus-ephemeral-servers)
- gnus-ephemeral-servers)))))
-;; (gnus-opened-servers-remove
-;; (car (assoc '(nnir "nnir-ephemeral" (nnir-address "nnir"))
-;; gnus-opened-servers))))
-
-
(defmacro nnir-add-result (dirnam artno score prefix server artlist)
@@ -931,8 +498,8 @@ ready to be added to the list of search results."
;; and with all subsequent slashes replaced by dots
(let ((group (replace-regexp-in-string
"[/\\]" "."
- (replace-regexp-in-string "^[./\\]" "" dirnam nil t)
- nil t)))
+ (replace-regexp-in-string "^[./\\]" "" dirnam nil t)
+ nil t)))
(vector (gnus-group-full-name group server)
(if (string-match "\\`nnmaildir:" (gnus-group-server server))
@@ -956,7 +523,6 @@ details on the language and supported extensions."
(save-excursion
(let ((qstring (cdr (assq 'query query)))
(server (cadr (gnus-server-to-method srv)))
- (defs (nth 2 (gnus-server-to-method srv)))
(criteria (or (cdr (assq 'criteria query))
(cdr (assoc nnir-imap-default-search-key
nnir-imap-search-arguments))))
@@ -968,33 +534,33 @@ details on the language and supported extensions."
(catch 'found
(mapcar
#'(lambda (group)
- (let (artlist)
- (condition-case ()
- (when (nnimap-change-group
- (gnus-group-short-name group) server)
- (with-current-buffer (nnimap-buffer)
- (message "Searching %s..." group)
- (let ((arts 0)
- (result (nnimap-command "UID SEARCH %s"
- (if (string= criteria "")
- qstring
- (nnir-imap-make-query
- criteria qstring)))))
- (mapc
- (lambda (artnum)
- (let ((artn (string-to-number artnum)))
- (when (> artn 0)
- (push (vector group artn 100)
- artlist)
- (when (assq 'shortcut query)
- (throw 'found (list 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))
- (nreverse artlist)))
+ (let (artlist)
+ (condition-case ()
+ (when (nnimap-change-group
+ (gnus-group-short-name group) server)
+ (with-current-buffer (nnimap-buffer)
+ (message "Searching %s..." group)
+ (let ((arts 0)
+ (result (nnimap-command "UID SEARCH %s"
+ (if (string= criteria "")
+ qstring
+ (nnir-imap-make-query
+ criteria qstring)))))
+ (mapc
+ (lambda (artnum)
+ (let ((artn (string-to-number artnum)))
+ (when (> artn 0)
+ (push (vector group artn 100)
+ artlist)
+ (when (assq 'shortcut query)
+ (throw 'found (list 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))
+ (nreverse artlist)))
groups))))))
(defun nnir-imap-make-query (criteria qstring)
@@ -1177,7 +743,7 @@ returning the one at the supplied position."
;; - article number
;; - file size
;; - group
-(defun nnir-run-swish++ (query server &optional group)
+(defun nnir-run-swish++ (query server &optional _group)
"Run QUERY against swish++.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1267,7 +833,7 @@ Windows NT 4.0."
(nnir-artitem-rsv y)))))))))
;; Swish-E interface.
-(defun nnir-run-swish-e (query server &optional group)
+(defun nnir-run-swish-e (query server &optional _group)
"Run given query against swish-e.
Returns a vector of (group name, file name) pairs (also vectors,
actually).
@@ -1433,7 +999,7 @@ Tested with swish-e-2.0.1 on Windows NT 4.0."
)))
;; Namazu interface
-(defun nnir-run-namazu (query server &optional group)
+(defun nnir-run-namazu (query server &optional _group)
"Run given query against Namazu. Returns a vector of (group name, file name)
pairs (also vectors, actually).
@@ -1502,7 +1068,7 @@ Tested with Namazu 2.0.6 on a GNU/Linux system."
(> (nnir-artitem-rsv x)
(nnir-artitem-rsv y)))))))))
-(defun nnir-run-notmuch (query server &optional group)
+(defun nnir-run-notmuch (query server &optional _group)
"Run QUERY against notmuch.
Returns a vector of (group name, file name) pairs (also vectors,
actually)."
@@ -1667,7 +1233,7 @@ actually)."
"Run a search against a gmane back-end server."
(let* ((case-fold-search t)
(qstring (cdr (assq 'query query)))
- (server (cadr (gnus-server-to-method srv)))
+; (server (cadr (gnus-server-to-method srv)))
(groupspec (mapconcat
(lambda (x)
(if (string-match-p "gmane" x)
@@ -1712,11 +1278,6 @@ actually)."
;;; 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'."
@@ -1763,54 +1324,13 @@ environment unless `not-global' is non-nil."
((and (not not-global) (boundp key)) (symbol-value key))
(t nil))))
-(defun nnir-possibly-change-group (group &optional server)
- (or (not server) (nnir-server-opened server) (nnir-open-server server))
- (when (gnus-nnir-group-p group)
- (setq nnir-artlist (gnus-group-get-parameter
- (gnus-group-prefixed-name
- (gnus-group-short-name group) '(nnir "nnir"))
- 'nnir-artlist t))))
-
-(defun nnir-server-opened (&optional server)
- (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
-installed, the server that the registry reports the current
-article came from is also searched."
- (let* ((query
- (list (cons 'query (nnimap-make-thread-query header))
- (cons 'criteria "")))
- (server
- (list (list (gnus-method-to-server
- (gnus-find-method-for-group gnus-newsgroup-name)))))
- (registry-group (and
- (bound-and-true-p gnus-registry-enabled)
- (car (gnus-registry-get-id-key
- (mail-header-id header) 'group))))
- (registry-server
- (and registry-group
- (gnus-method-to-server
- (gnus-find-method-for-group registry-group)))))
- (when registry-server
- (cl-pushnew (list registry-server) server :test #'equal))
- (gnus-group-make-nnir-group nil (list
- (cons 'nnir-query-spec query)
- (cons 'nnir-group-spec server)))
- (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
(defun nnir-get-active (srv)
(let ((method (gnus-server-to-method srv))
groups)
(gnus-request-list method)
(with-current-buffer nntp-server-buffer
- (let ((cur (current-buffer))
- name)
+ (let ((cur (current-buffer)))
(goto-char (point-min))
(unless (or (null nnir-ignored-newsgroups)
(string= nnir-ignored-newsgroups ""))
@@ -1847,80 +1367,6 @@ article came from is also searched."
(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
- action
- data-header
- (nnir-article-group (mail-header-number data-header))
- to
- method))
-
-(defun nnir-mode ()
- (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 (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)
- (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))))
-
-
-(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")))
- (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
- (or (cdr (assq 'nnir-artlist args))
- (nnir-run-query nnir-specs)))
- (nnir-request-update-info group (gnus-get-info group)))
- t)
-
-(deffoo nnir-request-delete-group (group &optional force server)
- t)
-
-(deffoo nnir-request-list (&optional server)
- t)
-
-(deffoo nnir-request-scan (group method)
- t)
-
-(deffoo nnir-request-close ()
- t)
-
-(nnoo-define-skeleton nnir)
-
;; The end.
(provide 'nnir)
diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el
new file mode 100644
index 0000000..4ba2be6
--- /dev/null
+++ b/lisp/gnus/nnselect.el
@@ -0,0 +1,774 @@
+;;; nnselect.el --- a virtual group backend -*- lexical-binding:t -*-
+
+;; Copyright (C) 2017 Free Software Foundation, Inc.
+
+;; Author: Andrew Cohen <address@hidden>
+;; Keywords: news mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This is a "virtual" backend that allows an aribtrary list of
+;; articles to be treated as a gnus group. An nnselect group uses an
+;; nnselect-spec group parameter to specify this list of
+;; articles. nnselect-spec is an alist with two keys:
+;; nnselect-function, whose value should be a function that returns
+;; the list of articles, and nnselect-args. The function will be
+;; applied to the arguments to generate the list of articles. The
+;; return value should be a vector, each element of which should in
+;; turn be a vector of three elements: a real prefixed group name, an
+;; article number in that group, and an integer score. The score is
+;; not used by nnselect but may be used by other code to help in
+;; sorting. Most functions will just chose a fixed number, such as
+;; 100, for this score.
+
+;; For example the search function `nnir-run-query' applied to
+;; arguments specifying a search query (see "nnir.el") can be used to
+;; return a list of articles from a search. Or the function can be the
+;; identity and the args a vector of articles.
+
+
+;;; Code:
+
+;;; Setup:
+
+
+(require 'nnoo)
+(require 'gnus-group)
+(require 'message)
+(require 'gnus-util)
+(require 'gnus-sum)
+
+(eval-when-compile (require 'cl-lib))
+
+;; Set up the backend
+
+(nnoo-declare nnselect)
+
+(nnoo-define-basics nnselect)
+
+(gnus-declare-backend "nnselect" 'mail 'virtual)
+
+;;; Internal Variables:
+
+(defvar gnus-inhibit-demon)
+(defvar gnus-message-group-art)
+
+;; (defvoo nnselect-artlist nil
+;; "Internal: stores the list of articles.")
+
+
+;; For future use
+(defvoo nnselect-directory gnus-directory
+ "Directory for the nnselect backend.")
+
+(defvoo nnselect-active-file
+ (expand-file-name "nnselect-active" nnselect-directory)
+ "nnselect active file.")
+
+(defvoo nnselect-groups-file
+ (expand-file-name "nnselect-newsgroups" nnselect-directory)
+ "nnselect groups description file.")
+
+
+;;; Helper macros
+
+;; Data type article list.
+
+(defmacro nnselect-artlist-length (artlist)
+ "Return number of articles in ARTLIST."
+ `(length ,artlist))
+
+(defmacro nnselect-artlist-article (artlist n)
+ "Return from ARTLIST the Nth artitem (counting starting at 1)."
+ `(when (> ,n 0)
+ (elt ,artlist (1- ,n))))
+
+(defmacro nnselect-artitem-group (artitem)
+ "Return the group from the ARTITEM."
+ `(elt ,artitem 0))
+
+(defmacro nnselect-artitem-number (artitem)
+ "Return the number from the ARTITEM."
+ `(elt ,artitem 1))
+
+(defmacro nnselect-artitem-rsv (artitem)
+ "Return the Retrieval Status Value (RSV, score) from the ARTITEM."
+ `(elt ,artitem 2))
+
+(defmacro nnselect-article-group (article)
+ "Return the group for ARTICLE."
+ `(nnselect-artitem-group (nnselect-artlist-article nnselect-artlist
,article)))
+
+(defmacro nnselect-article-number (article)
+ "Return the number for ARTICLE."
+ `(nnselect-artitem-number (nnselect-artlist-article nnselect-artlist
,article)))
+
+(defmacro nnselect-article-rsv (article)
+ "Return the rsv for ARTICLE."
+ `(nnselect-artitem-rsv (nnselect-artlist-article nnselect-artlist ,article)))
+
+(defmacro nnselect-article-id (article)
+ "Return the pair `(nnselect id . real id)' of ARTICLE."
+ `(cons ,article (nnselect-article-number ,article)))
+
+(defmacro ids-by-group (articles)
+ `(nnselect-categorize ,articles nnselect-article-group nnselect-article-id))
+
+(defmacro numbers-by-group (articles)
+ `(nnselect-categorize ,articles nnselect-article-group
nnselect-article-number))
+
+(defmacro nnselect-categorize (sequence keyfunc &optional valuefunc)
+ "Sorts a sequence into categories and returns a list of the form
+`((key1 (element11 element12)) (key2 (element21 element22))'.
+The category key for a member of the sequence is obtained
+as `(keyfunc member)' and the corresponding element is just
+`member' (or `(valuefunc member)' if `valuefunc' is non-nil)."
+ (let ((key (make-symbol "key"))
+ (value (make-symbol "value"))
+ (result (make-symbol "result"))
+ (valuefunc (or valuefunc 'identity)))
+ `(unless (null ,sequence)
+ (let (,result)
+ (mapc
+ (lambda (member)
+ (let* ((,key (,keyfunc member))
+ (,value (,valuefunc member))
+ (kr (assoc ,key ,result)))
+ (if kr
+ (push ,value (cadr kr))
+ (push (list ,key (list ,value)) ,result))))
+ ,sequence)
+ ,result))))
+
+
+;;; User Customizable Variables:
+
+(defgroup nnselect nil
+ "Virtual groups in Gnus with arbitrary selection methods."
+ :group 'gnus)
+
+(defcustom nnselect-summary-line-format nil
+ "The format specification of the lines in an nnselect summary buffer.
+
+All the items from `gnus-summary-line-format' are available, along
+with three items unique to nnselect summary buffers:
+
+%Z Retrieval score value (integer)
+%G Article original full group name (string)
+%g Article original short group name (string)
+
+If nil this will use `gnus-summary-line-format'."
+ :version "24.1"
+ :type '(string)
+ :group 'nnselect)
+
+(defcustom nnselect-retrieve-headers-override-function nil
+ "A function that retrieves article headers for ARTICLES from GROUP.
+The retrieved headers should populate the `nntp-server-buffer'.
+Returns either the retrieved header format 'nov or 'headers.
+
+If this variable is nil, or if the provided function returns nil,
+ `gnus-retrieve-headers' will be called instead."
+ :version "24.1" :type '(function) :group 'nnselect)
+
+
+;; Gnus backend interface functions.
+
+(deffoo nnselect-open-server (server &optional definitions)
+ ;; Just set the server variables appropriately.
+ (let ((backend (car (gnus-server-to-method server))))
+ (if backend
+ (nnoo-change-server backend server definitions)
+ (nnoo-change-server 'nnselect server definitions))))
+
+(deffoo nnselect-request-group (group &optional server dont-check _info)
+ (let ((group (nnselect-possibly-change-group group server))
+ length)
+ ;; Check for cached select result or run the selection and cache
+ ;; the result.
+ (unless (and nnselect-artlist dont-check)
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (setq nnselect-artlist
+ (nnselect-run
+ (gnus-group-get-parameter group 'nnselect-specs t))))
+ (nnselect-request-update-info group (gnus-get-info group)))
+ (if (zerop (setq length (nnselect-artlist-length nnselect-artlist)))
+ (progn
+ (nnselect-close-group group)
+ (nnheader-report 'nnselect "Selection produced empty results."))
+ (with-current-buffer nntp-server-buffer
+ (nnheader-insert "211 %d %d %d %s\n"
+ length ; total #
+ 1 ; first #
+ length ; last #
+ group)))) ; group name
+ nnselect-artlist)
+
+(deffoo nnselect-retrieve-headers (articles &optional _group _server fetch-old)
+ (let ((gnus-inhibit-demon t)
+ (gartids (ids-by-group articles))
+ headers)
+ (with-current-buffer nntp-server-buffer
+ (pcase-dolist (`(,artgroup ,artids) gartids)
+ (let ((artlist (sort (mapcar 'cdr artids) '<))
+ (gnus-override-method (gnus-find-method-for-group artgroup))
+ parsefunc)
+ (erase-buffer)
+ (pcase (setq gnus-headers-retrieved-by
+ (or
+ (and
+ nnselect-retrieve-headers-override-function
+ (funcall nnselect-retrieve-headers-override-function
+ artlist artgroup))
+ (gnus-retrieve-headers artlist artgroup fetch-old)))
+ ('nov
+ (setq parsefunc 'nnheader-parse-nov))
+ ('headers
+ (setq parsefunc 'nnheader-parse-head))
+ (_ (error "Unknown header type %s while requesting articles \
+ of group %s" gnus-headers-retrieved-by artgroup)))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (let* ((novitem (funcall parsefunc))
+ (artno (and novitem
+ (mail-header-number novitem)))
+ (art (car (rassq artno artids))))
+ (when art
+ (mail-header-set-number novitem art)
+ (push novitem headers))
+ (forward-line 1)))))
+ (setq headers
+ (sort headers
+ (lambda (x y)
+ (< (mail-header-number x) (mail-header-number y)))))
+ (erase-buffer)
+ (mapc 'nnheader-insert-nov headers)
+ 'nov)))
+
+(deffoo nnselect-request-article (article &optional group server to-buffer)
+ (nnselect-possibly-change-group group server)
+ ;; We shoud only arrive here if we are in an nnselect group and we
+ ;; are requesting a real article. Just find the originating
+ ;; group for the article and pass the request on.
+ (when (numberp article)
+ (unless (zerop (nnselect-artlist-length nnselect-artlist))
+ (let ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article)))
+ (message "Requesting article %d from group %s"
+ artnumber artgroup)
+ (if to-buffer
+ (with-current-buffer to-buffer
+ (let ((gnus-article-decode-hook nil))
+ (gnus-request-article-this-buffer artnumber artgroup)))
+ (gnus-request-article artnumber artgroup))
+ (cons artgroup artnumber)))))
+
+
+(deffoo nnselect-request-move-article (article group server accept-form
+ &optional last _internal-move-group)
+ (nnselect-possibly-change-group group server)
+ (let* ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article))
+ (to-newsgroup (nth 1 accept-form))
+ (to-method (gnus-find-method-for-group to-newsgroup))
+ (from-method (gnus-find-method-for-group artgroup))
+ (move-is-internal (gnus-server-equal from-method to-method)))
+ (unless (gnus-check-backend-function
+ 'request-move-article artgroup)
+ (error "The group %s does not support article moving" artgroup))
+ (gnus-request-move-article
+ artnumber
+ artgroup
+ (nth 1 from-method)
+ accept-form
+ last
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ (gnus-group-real-name to-newsgroup)))))
+
+
+(deffoo nnselect-request-expire-articles (articles group &optional server
force)
+ (nnselect-possibly-change-group group server)
+ (if force
+ (let (not-expired)
+ (pcase-dolist (`(,artgroup ,artids) (ids-by-group articles))
+ (let ((artlist (sort (mapcar 'cdr artids) '<)))
+ (unless (gnus-check-backend-function 'request-expire-articles
+ artgroup)
+ (error "Group %s does not support article expiration" artgroup))
+ (unless (gnus-check-server (gnus-find-method-for-group artgroup))
+ (error "Couldn't open server for group %s" artgroup))
+ (push (mapcar #'(lambda (art)
+ (car (rassq art artids)))
+ (gnus-request-expire-articles
+ artlist artgroup force))
+ not-expired)))
+ (sort (delq nil not-expired) '<))
+ articles))
+
+(deffoo nnselect-warp-to-article ()
+ (nnselect-possibly-change-group gnus-newsgroup-name)
+ (let* ((cur (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (error "Can't warp to a pseudo-article")))
+ (artgroup (nnselect-article-group cur))
+ (artnumber (nnselect-article-number cur))
+ (_quit-config (gnus-ephemeral-group-p gnus-newsgroup-name)))
+
+ ;; what should we do here? we could leave all the buffers around
+ ;; and assume that we have to exit from them one by one. or we can
+ ;; try to clean up directly
+
+ ;;first exit from the nnselect summary buffer.
+; (gnus-summary-exit)
+ ;; and if the nnselect summary buffer in turn came from another
+ ;; summary buffer we have to clean that summary up too.
+ ; (when (not (eq (cdr quit-config) 'group))
+; (gnus-summary-exit))
+ (gnus-summary-read-group-1 artgroup t t nil
+ nil (list artnumber))))
+
+
+;; we pass this through to the real group in case it wants to adjust
+;; the mark. We also use this to mark an article expirable iff it is
+;; expirable in the real group.
+(deffoo nnselect-request-update-mark (_group article mark)
+ (let* ((artgroup (nnselect-article-group article))
+ (artnumber (nnselect-article-number article))
+ (gmark (gnus-request-update-mark artgroup artnumber mark)))
+ (when (and artnumber
+ (memq mark gnus-auto-expirable-marks)
+ (= mark gmark)
+ (gnus-group-auto-expirable-p artgroup))
+ (setq gmark gnus-expirable-mark))
+ gmark))
+
+(deffoo nnselect-request-set-mark (group actions &optional server)
+ (nnselect-possibly-change-group group server)
+ (mapc
+ (lambda (request) (gnus-request-set-mark (car request) (cadr request)))
+ (nnselect-categorize
+ (cl-mapcan
+ (lambda (act)
+ (destructuring-bind (range action marks) act
+ (mapcar
+ (lambda (artgroup)
+ (list (car artgroup)
+ (list (gnus-compress-sequence (sort (cadr artgroup) '<))
+ action marks)))
+ (numbers-by-group
+ (gnus-uncompress-range range)))))
+ actions)
+ car cadr)))
+
+(deffoo nnselect-request-update-info (group info &optional server)
+ (let ((group (nnselect-possibly-change-group group server)))
+ (gnus-info-set-marks info nil)
+ (gnus-info-set-read info nil)
+ (pcase-dolist (`(,artgroup ,nartids)
+ (ids-by-group
+ (number-sequence
+ 1 (nnselect-artlist-length nnselect-artlist))))
+ (let* ((gnus-newsgroup-active nil)
+ (artids (cl-sort nartids '< :key 'car))
+ (group-info (gnus-get-info artgroup))
+ (marks (gnus-info-marks group-info))
+ (read (gnus-uncompress-sequence (gnus-info-read group-info))))
+ (gnus-atomic-progn
+ (gnus-info-set-read
+ info
+ (gnus-add-to-range
+ (gnus-info-read info)
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (member (cdr art) read) (car art)))
+ artids))))
+ (pcase-dolist (`(,type . ,range) marks)
+ (setq range (gnus-uncompress-sequence range))
+ (gnus-add-marked-articles
+ group type
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (member (cdr art) range)
+ (car art))) artids))))))))
+ (gnus-set-active group (cons 1 (nnselect-artlist-length nnselect-artlist))))
+
+
+(deffoo nnselect-request-thread (header &optional group server)
+ (let ((group (nnselect-possibly-change-group group server))
+ (artgroup (nnselect-article-group
+ (if (> (mail-header-number header) 0)
+ (mail-header-number header)
+ (with-current-buffer gnus-summary-buffer
+ (if (> (gnus-summary-article-number) 0)
+ (gnus-summary-article-number)
+ (let ((thread
+ (gnus-id-to-thread (mail-header-id header))))
+ (when thread
+ (cl-some #'(lambda (x)
+ (when (and x (> x 0)) x))
+ (gnus-articles-in-thread thread))))))))))
+ ;; Check if we are dealing with an imap backend.
+ (if (eq 'nnimap
+ (car (gnus-find-method-for-group artgroup)))
+ ;; If so we perform the query, massage the result, and return
+ ;; the new headers back to the caller to incorporate into the
+ ;; current summary buffer.
+ (let* ((group-spec
+ (list (delq nil (list
+ (or server (gnus-group-server artgroup))
+ (unless gnus-refer-thread-use-search
+ (list artgroup))))))
+ (query-spec
+ (list (cons 'query (nnimap-make-thread-query header))
+ (cons 'criteria "")))
+ (last (nnselect-artlist-length nnselect-artlist))
+ (first (1+ last))
+ (new-nnselect-artlist
+ (nnir-run-query
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec))))
+ old-arts seq
+ headers)
+ ;; The search will likely find articles that are already
+ ;; present in the nnselect summary buffer. We remove these from
+ ;; the search result. However even though these articles are
+ ;; in the original article list their headers may not have
+ ;; been retrieved, so we retrieve them just in case. We
+ ;; could identify and skip the ones that have been retrieved
+ ;; but its probably faster to just get them all.
+ (mapc
+ #'(lambda (article)
+ (if
+ (setq seq
+ (cl-position article nnselect-artlist :test 'equal))
+ (push (1+ seq) old-arts)
+ (setq nnselect-artlist
+ (vconcat nnselect-artlist (vector article)))
+ (incf last)))
+ new-nnselect-artlist)
+ (setq headers
+ (gnus-fetch-headers
+ (append (sort old-arts '<)
+ (gnus-uncompress-range (cons first last))) nil t))
+ (gnus-group-set-parameter
+ group
+ 'nnselect-artlist
+ nnselect-artlist)
+
+ (when (>= last first)
+ (let (new-marks)
+ (pcase-dolist (`(,artgroup ,artids)
+ (ids-by-group (number-sequence first last)))
+ (pcase-dolist (`(,type . ,marked)
+ (gnus-info-marks (gnus-get-info artgroup)))
+ (setq marked (gnus-uncompress-sequence marked))
+ (when (setq new-marks
+ (delq nil
+ (mapcar
+ #'(lambda (art)
+ (when (member (cdr art) marked)
+ (car art)))
+ artids)))
+ (nconc
+ (symbol-value (intern (format "gnus-newsgroup-%s"
+ (car (rassq type gnus-article-mark-lists)))))
+ new-marks)))))
+ (setq gnus-newsgroup-active
+ (cons 1 (nnselect-artlist-length nnselect-artlist)))
+ (gnus-set-active
+ group
+ (cons 1 (nnselect-artlist-length nnselect-artlist))))
+ headers)
+ ;; If not an imap backend just warp to the original article
+ ;; group and punt back to gnus-summary-refer-thread.
+ (and (gnus-warp-to-article) (gnus-summary-refer-thread)))))
+
+
+
+(deffoo nnselect-close-group (group &optional server)
+ (let ((group (nnselect-possibly-change-group group server)))
+ (unless gnus-group-is-exiting-without-update-p
+ (nnselect-push-info group))
+ (setq nnselect-artlist nil)
+ (when (gnus-ephemeral-group-p group)
+ (gnus-kill-ephemeral-group group)
+ (setq gnus-ephemeral-servers
+ (assq-delete-all 'nnselect gnus-ephemeral-servers)))))
+
+
+(deffoo nnselect-request-create-group (group &optional _server args)
+ (message "Creating nnselect group %s" group)
+ (let* ((group (gnus-group-prefixed-name group '(nnselect "nnselect")))
+ (specs (assq 'nnselect-specs args))
+ (function-spec
+ (or (alist-get 'nnselect-function specs)
+ (list
+ (read-from-minibuffer "Function: " nil nil t))))
+ (args-spec
+ (or (alist-get 'nnselect-args specs)
+ (read-from-minibuffer "Args: " nil nil t)))
+ (nnselect-specs (list (cons 'nnselect-function function-spec)
+ (cons 'nnselect-args args-spec))))
+ (gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
+ (gnus-group-set-parameter
+ group 'nnselect-artlist
+ (or (alist-get 'nnselect-artlist args)
+ (nnselect-run nnselect-specs)))
+ (nnselect-request-update-info group (gnus-get-info group)))
+ t)
+
+
+(deffoo nnselect-request-type (_group &optional article)
+ (if (and (numberp article) (> article 0))
+ (gnus-request-type
+ (nnselect-article-group article) (nnselect-article-number article))
+ 'unknown))
+
+(deffoo nnselect-request-post (&optional _server)
+ (if (not gnus-message-group-art)
+ (nnheader-report 'nnselect "Can't post to an nnselect group")
+ (gnus-request-post
+ (gnus-find-method-for-group
+ (nnselect-article-group (cdr gnus-message-group-art))))))
+
+
+(deffoo nnselect-request-scan (_group _method)
+ t)
+
+(deffoo nnselect-request-list (&optional _server)
+ t)
+
+;; Add any undefined required backend functions
+
+(nnoo-define-skeleton nnselect)
+
+;;; Util Code:
+
+(defun gnus-nnselect-group-p (group)
+ "Say whether GROUP is nnselect or not."
+ (or (and (gnus-group-prefixed-p group)
+ (eq 'nnselect (car (gnus-find-method-for-group group))))
+ (eq 'nnselect (car gnus-command-method))))
+
+
+(defun nnselect-run (specs)
+ "Apply FUNCTION to ARGS and return an article list."
+ (let ((func (alist-get 'nnselect-function specs))
+ (args (alist-get 'nnselect-args specs)))
+ (funcall func args)))
+
+
+(defun nnselect-possibly-change-group (group &optional server)
+ "If GROUP method for SERVER is `nnselect' install the
+`nnselect-artlist'. Return the fully prefixed group name."
+ (or (not server) (nnselect-server-opened server)
+ (nnselect-open-server server))
+ (let ((group (gnus-group-prefixed-name
+ (gnus-group-short-name group) '(nnselect "nnselect"))))
+ (when (gnus-nnselect-group-p group)
+ (setq nnselect-artlist (gnus-group-get-parameter
+ group
+ 'nnselect-artlist t)))
+ group))
+
+
+(defun nnselect-server-opened (&optional server)
+ "Open SERVER if not yet opened."
+ (let ((backend (car (gnus-server-to-method server))))
+ (nnoo-current-server-p (or backend 'nnselect) server)))
+
+(defun nnselect-search-thread (header)
+ "Make an nnselect group containing the thread with article HEADER.
+The current server will be searched. If the registry is
+installed, the server that the registry reports the current
+article came from is also searched."
+ (let* ((query
+ (list (cons 'query (nnimap-make-thread-query header))
+ (cons 'criteria "")))
+ (server
+ (list (list (gnus-method-to-server
+ (gnus-find-method-for-group gnus-newsgroup-name)))))
+ (registry-group (and
+ (bound-and-true-p gnus-registry-enabled)
+ (car (gnus-registry-get-id-key
+ (mail-header-id header) 'group))))
+ (registry-server
+ (and registry-group
+ (gnus-method-to-server
+ (gnus-find-method-for-group registry-group)))))
+ (when registry-server (cl-pushnew (list registry-server) server
+ :test 'equal))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+ ; nil
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query)
+ (cons 'nnir-group-spec server)))))
+ (cons 'nnselect-artlist nil)))
+ (gnus-summary-goto-subject (gnus-id-to-article (mail-header-id header)))))
+
+
+
+(defun nnselect-push-info (group)
+ "Copy read and article mark info from the nnselect group to the
+originating groups."
+ (let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
+ (select-reads (numbers-by-group
+ (gnus-uncompress-range
+ (gnus-info-read (gnus-get-info group)))))
+ (gnus-newsgroup-active nil)
+ mark-list type-list)
+ (pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
+ (when (setq type-list
+ (symbol-value (intern (format "gnus-newsgroup-%s" mark))))
+ (push (cons type
+ (numbers-by-group
+ (reverse (gnus-uncompress-range type-list)))) mark-list)))
+ (pcase-dolist (`(,artgroup ,artlist)
+ (numbers-by-group gnus-newsgroup-articles))
+ (let* ((group-info (gnus-get-info artgroup))
+ (old-unread (gnus-list-of-unread-articles artgroup))
+ newmarked)
+ (pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
+ (let ((select-type
+ (sort
+ (cadr (assoc artgroup (alist-get type mark-list)))
+ '<)) list)
+ (setq list
+ (gnus-uncompress-range
+ (gnus-add-to-range
+ (gnus-remove-from-range
+ (alist-get type (gnus-info-marks group-info))
+ artlist)
+ select-type)))
+
+ ;; When exiting the group, everything that's previously been
+ ;; unseen is now seen.
+ (when (eq type 'seen)
+ (setq list (gnus-range-add list gnus-newsgroup-unseen)))
+
+ ;; (when (or (eq (gnus-article-mark-to-type type) 'list)
+ ;; (eq (gnus-article-mark-to-type type) 'range))
+ ;; (setq list (gnus-compress-sequence (sort list '<) t)))
+
+ (when (eq (gnus-article-mark-to-type type) 'list)
+ (setq list
+ (gnus-compress-sequence (sort list '<) t)))
+
+ (when (or list (eq type 'unexist))
+ (push (cons type list) newmarked))))
+
+ (gnus-atomic-progn
+ ;; Enter these new marks into the info of the group.
+ (if (nthcdr 3 group-info)
+ (setcar (nthcdr 3 group-info) newmarked)
+ ;; Add the marks lists to the end of the info.
+ (when newmarked
+ (setcdr (nthcdr 2 group-info) (list newmarked))))
+
+ ;; Cut off the end of the info if there's nothing else there.
+ (let ((i 5))
+ (while (and (> i 2)
+ (not (nth i group-info)))
+ (when (nthcdr (decf i) group-info)
+ (setcdr (nthcdr i group-info) nil))))
+
+ ;; update read and unread
+ (gnus-update-read-articles
+ artgroup
+ (gnus-uncompress-range
+ (gnus-add-to-range
+ (gnus-remove-from-range
+ old-unread
+ (cadr (assoc artgroup select-reads)))
+ (sort (cadr (assoc artgroup select-unreads)) '<))))
+ (gnus-get-unread-articles-in-group
+ group-info (gnus-active artgroup) t)
+ (gnus-group-update-group artgroup t))))))
+
+
+(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
+(declare-function gnus-group-topic-name "gnus-topic" ())
+(declare-function nnir-read-parms "nnir" (search-engine))
+(declare-function nnir-server-to-search-engine "nnir" (server))
+
+(defun gnus-group-make-search-group (nnir-extra-parms &optional specs)
+ "Create an nnselect group based on a search. Prompt for a
+search query and determine the groups to search as follows: if
+called from the *Server* buffer search all groups belonging to
+the server on the current line; if called from the *Group* buffer
+search any marked groups, or the group on the current line, or
+all the groups under the current topic. Calling with a prefix-arg
+prompts for additional search-engine specific constraints. A
+non-nil `specs' arg must be an alist with `nnir-query-spec' and
+`nnir-group-spec' keys, and skips all prompting."
+ (interactive "P")
+ (let* ((group-spec
+ (or (cdr (assq 'nnir-group-spec specs))
+ (if (gnus-server-server-name)
+ (list (list (gnus-server-server-name)))
+ (nnselect-categorize
+ (or gnus-group-marked
+ (if (gnus-group-group-name)
+ (list (gnus-group-group-name))
+ (cdr (assoc (gnus-group-topic-name) gnus-topic-alist))))
+ gnus-group-server))))
+ (query-spec
+ (or (cdr (assq 'nnir-query-spec specs))
+ (apply
+ 'append
+ (list (cons 'query
+ (read-string "Query: " nil 'nnir-search-history)))
+ (when nnir-extra-parms
+ (mapcar
+ (lambda (x)
+ (nnir-read-parms (nnir-server-to-search-engine (car x))))
+ group-spec))))))
+ (gnus-group-read-ephemeral-group
+ (concat "nnselect-" (message-unique-id))
+ (list 'nnselect "nnselect")
+ nil
+ (cons (current-buffer) gnus-current-window-configuration)
+; nil
+ nil nil
+ (list
+ (cons 'nnselect-specs
+ (list
+ (cons 'nnselect-function 'nnir-run-query)
+ (cons 'nnselect-args
+ (list (cons 'nnir-query-spec query-spec)
+ (cons 'nnir-group-spec group-spec)))))
+ (cons 'nnselect-artlist nil)))))
+
+
+;; The end.
+(provide 'nnselect)
+
+;;; nnselect.el ends here