mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-23 07:19:15 +00:00
ecf08f0621
dc4e6b1329; Update copyright years in more files64b3777631; Run set-copyright from admin.el8e1c56ae46; Add 2024 to copyright years # Conflicts: # doc/misc/modus-themes.org # doc/misc/texinfo.tex # etc/NEWS # etc/refcards/ru-refcard.tex # etc/themes/modus-operandi-theme.el # etc/themes/modus-themes.el # etc/themes/modus-vivendi-theme.el # lib/alloca.in.h # lib/binary-io.h # lib/c-ctype.h # lib/c-strcasecmp.c # lib/c-strncasecmp.c # lib/careadlinkat.c # lib/cloexec.c # lib/close-stream.c # lib/diffseq.h # lib/dup2.c # lib/filemode.h # lib/fpending.c # lib/fpending.h # lib/fsusage.c # lib/getgroups.c # lib/getloadavg.c # lib/gettext.h # lib/gettime.c # lib/gettimeofday.c # lib/group-member.c # lib/malloc.c # lib/md5-stream.c # lib/md5.c # lib/md5.h # lib/memmem.c # lib/memrchr.c # lib/nanosleep.c # lib/save-cwd.h # lib/sha1.c # lib/sig2str.c # lib/stdlib.in.h # lib/strtoimax.c # lib/strtol.c # lib/strtoll.c # lib/time_r.c # lib/xalloc-oversized.h # lisp/auth-source-pass.el # lisp/emacs-lisp/lisp-mnt.el # lisp/emacs-lisp/timer.el # lisp/info-look.el # lisp/jit-lock.el # lisp/loadhist.el # lisp/mail/rmail.el # lisp/net/ntlm.el # lisp/net/webjump.el # lisp/progmodes/asm-mode.el # lisp/progmodes/project.el # lisp/progmodes/sh-script.el # lisp/textmodes/flyspell.el # lisp/textmodes/reftex-toc.el # lisp/textmodes/reftex.el # lisp/textmodes/tex-mode.el # lisp/url/url-gw.el # m4/alloca.m4 # m4/clock_time.m4 # m4/d-type.m4 # m4/dirent_h.m4 # m4/dup2.m4 # m4/euidaccess.m4 # m4/fchmodat.m4 # m4/filemode.m4 # m4/fsusage.m4 # m4/getgroups.m4 # m4/getloadavg.m4 # m4/getrandom.m4 # m4/gettime.m4 # m4/gettimeofday.m4 # m4/gnulib-common.m4 # m4/group-member.m4 # m4/inttypes.m4 # m4/malloc.m4 # m4/manywarnings.m4 # m4/mempcpy.m4 # m4/memrchr.m4 # m4/mkostemp.m4 # m4/mktime.m4 # m4/nproc.m4 # m4/nstrftime.m4 # m4/pathmax.m4 # m4/pipe2.m4 # m4/pselect.m4 # m4/pthread_sigmask.m4 # m4/readlink.m4 # m4/realloc.m4 # m4/sig2str.m4 # m4/ssize_t.m4 # m4/stat-time.m4 # m4/stddef_h.m4 # m4/stdint.m4 # m4/stdio_h.m4 # m4/stdlib_h.m4 # m4/stpcpy.m4 # m4/strnlen.m4 # m4/strtoimax.m4 # m4/strtoll.m4 # m4/time_h.m4 # m4/timegm.m4 # m4/timer_time.m4 # m4/timespec.m4 # m4/unistd_h.m4 # m4/warnings.m4 # nt/configure.bat # nt/preprep.c # test/lisp/register-tests.el
1072 lines
43 KiB
EmacsLisp
1072 lines
43 KiB
EmacsLisp
;;; nnselect.el --- a virtual group backend -*- lexical-binding:t -*-
|
|
|
|
;; Copyright (C) 2020-2024 Free Software Foundation, Inc.
|
|
|
|
;; Author: Andrew Cohen <cohen@andy.bu.edu>
|
|
;; 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 <https://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This is a "virtual" backend that allows an arbitrary 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 choose a fixed number, such as
|
|
;; 100, for this score.
|
|
|
|
;; For example the search function `gnus-search-run-query' applied to
|
|
;; arguments specifying a search query (see "gnus-search.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 'gnus-art)
|
|
(autoload 'gnus-search-run-query "gnus-search")
|
|
(autoload 'gnus-search-server-to-engine "gnus-search")
|
|
|
|
(eval-when-compile (require 'cl-lib))
|
|
|
|
;; Set up the backend
|
|
|
|
(nnoo-declare nnselect)
|
|
|
|
(nnoo-define-basics nnselect)
|
|
|
|
(gnus-declare-backend "nnselect" 'post-mail 'virtual)
|
|
|
|
;;; Internal Variables:
|
|
|
|
(defvar gnus-inhibit-demon)
|
|
(defvar gnus-message-group-art)
|
|
(defvar gnus-search-use-parsed-queries)
|
|
|
|
;; 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 routines.
|
|
(defun nnselect-compress-artlist (artlist)
|
|
"Compress ARTLIST."
|
|
(if (consp artlist)
|
|
artlist
|
|
(let (selection)
|
|
(pcase-dolist (`(,artgroup . ,arts)
|
|
(nnselect-categorize artlist #'nnselect-artitem-group))
|
|
(let (list)
|
|
(pcase-dolist (`(,rsv . ,articles)
|
|
(nnselect-categorize
|
|
arts #'nnselect-artitem-rsv #'nnselect-artitem-number))
|
|
(push (cons rsv (gnus-compress-sequence (sort articles #'<)))
|
|
list))
|
|
(push (cons artgroup (sort list 'car-less-than-car)) selection)))
|
|
(sort selection (lambda (x y) (string< (car x) (car y)))))))
|
|
|
|
(defun nnselect-uncompress-artlist (artlist)
|
|
"Uncompress ARTLIST."
|
|
(if (vectorp artlist)
|
|
artlist
|
|
(let (selection)
|
|
(pcase-dolist (`(,artgroup . ,list) artlist)
|
|
(pcase-dolist (`(,artrsv . ,artseq) list)
|
|
(setq selection
|
|
(vconcat selection
|
|
(cl-map 'vector
|
|
(lambda (art)
|
|
(vector artgroup art artrsv))
|
|
(gnus-uncompress-sequence artseq))))))
|
|
(sort selection
|
|
(lambda (x y)
|
|
(< (nnselect-artitem-rsv x) (nnselect-artitem-rsv y)))))))
|
|
|
|
(make-obsolete 'nnselect-group-server 'gnus-group-server "28.1")
|
|
(make-obsolete 'nnselect-run 'nnselect-generate-artlist "29.1")
|
|
(make-obsolete 'nnselect-search-thread 'gnus-search-thread "29.1")
|
|
|
|
;; Data type article list.
|
|
|
|
(define-inline nnselect-artlist-length (artlist)
|
|
(inline-quote (length ,artlist)))
|
|
|
|
(define-inline nnselect-artlist-article (artlist n)
|
|
"Return from ARTLIST the Nth artitem (counting starting at 1)."
|
|
(inline-quote (when (> ,n 0)
|
|
(elt ,artlist (1- ,n)))))
|
|
|
|
(define-inline nnselect-artitem-group (artitem)
|
|
"Return the group from the ARTITEM."
|
|
(inline-quote (elt ,artitem 0)))
|
|
|
|
(define-inline nnselect-artitem-number (artitem)
|
|
"Return the number from the ARTITEM."
|
|
(inline-quote (elt ,artitem 1)))
|
|
|
|
(define-inline nnselect-artitem-rsv (artitem)
|
|
"Return the Retrieval Status Value (RSV, score) from the ARTITEM."
|
|
(inline-quote (elt ,artitem 2)))
|
|
|
|
(define-inline nnselect-article-group (article)
|
|
"Return the group for ARTICLE."
|
|
(inline-quote
|
|
(nnselect-artitem-group (nnselect-artlist-article
|
|
gnus-newsgroup-selection ,article))))
|
|
|
|
(define-inline nnselect-article-number (article)
|
|
"Return the number for ARTICLE."
|
|
(inline-quote (nnselect-artitem-number
|
|
(nnselect-artlist-article
|
|
gnus-newsgroup-selection ,article))))
|
|
|
|
(define-inline nnselect-article-rsv (article)
|
|
"Return the rsv for ARTICLE."
|
|
(inline-quote (nnselect-artitem-rsv
|
|
(nnselect-artlist-article
|
|
gnus-newsgroup-selection ,article))))
|
|
|
|
(define-inline nnselect-article-id (article)
|
|
"Return the pair `(nnselect id . real id)' of ARTICLE."
|
|
(inline-quote (cons ,article (nnselect-article-number ,article))))
|
|
|
|
(define-inline nnselect-categorize (sequence keyfunc &optional valuefunc)
|
|
"Sorts a sequence into categories.
|
|
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)."
|
|
(inline-letevals (sequence keyfunc valuefunc)
|
|
(inline-quote (let ((valuefunc (or ,valuefunc 'identity))
|
|
result)
|
|
(unless (null ,sequence)
|
|
(mapc
|
|
(lambda (member)
|
|
(let* ((key (funcall ,keyfunc member))
|
|
(value (funcall valuefunc member))
|
|
(kr (assoc key result)))
|
|
(if kr
|
|
(push value (cdr kr))
|
|
(push (list key value) result))))
|
|
(reverse ,sequence))
|
|
result)))))
|
|
|
|
|
|
;; Unclear whether a macro or an inline function is best.
|
|
;; (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 (cdr kr))
|
|
;; (push (list ,key ,value) ,result))))
|
|
;; (reverse ,sequence))
|
|
;; ,result))))
|
|
|
|
(define-inline ids-by-group (articles)
|
|
(inline-quote
|
|
(nnselect-categorize ,articles #'nnselect-article-group
|
|
#'nnselect-article-id)))
|
|
|
|
(define-inline numbers-by-group (articles &optional type)
|
|
(inline-quote
|
|
(cond
|
|
((eq ,type 'range)
|
|
(nnselect-categorize (range-uncompress ,articles)
|
|
#'nnselect-article-group #'nnselect-article-number))
|
|
((eq ,type 'tuple)
|
|
(nnselect-categorize ,articles
|
|
(lambda (elem)
|
|
(nnselect-article-group (car elem)))
|
|
(lambda (elem)
|
|
(cons (nnselect-article-number
|
|
(car elem))
|
|
(cdr elem)))))
|
|
(t
|
|
(nnselect-categorize ,articles
|
|
#'nnselect-article-group
|
|
#'nnselect-article-number)))))
|
|
|
|
(defmacro nnselect-add-prefix (group)
|
|
"Ensures that the GROUP has an nnselect prefix."
|
|
`(gnus-group-prefixed-name
|
|
(gnus-group-short-name ,group) '(nnselect "nnselect")))
|
|
|
|
|
|
(defmacro nnselect-add-novitem (novitem)
|
|
"Add NOVITEM to the list of headers."
|
|
`(let* ((novitem ,novitem)
|
|
(artno (and novitem
|
|
(mail-header-number novitem)))
|
|
(art (car-safe (rassq artno artids))))
|
|
(when art
|
|
(setf (mail-header-number novitem) art)
|
|
(push novitem headers))))
|
|
|
|
;;; User Customizable Variables:
|
|
|
|
(defgroup nnselect nil
|
|
"Virtual groups in Gnus with arbitrary selection methods."
|
|
:group 'gnus)
|
|
|
|
(define-obsolete-variable-alias 'nnir-retrieve-headers-override-function
|
|
'nnselect-retrieve-headers-override-function "28.1")
|
|
|
|
(defcustom nnselect-allow-ephemeral-expiry nil
|
|
"If non-nil, articles in ephemeral nnselect groups are subject to expiry."
|
|
:version "29.1"
|
|
:type 'boolean)
|
|
|
|
(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 "28.1"
|
|
:type '(repeat function))
|
|
|
|
(defmacro nnselect-get-artlist (group)
|
|
"Get the stored list of articles for GROUP.
|
|
If the group parameter `nnselect-get-artlist-override-function'
|
|
is non-nil call this function with argument GROUP to get the
|
|
artlist; if the group parameter `nnselect-always-regenerate' is
|
|
non-nil, return nil to regenerate the artlist; otherwise retrieve
|
|
the stored artlist from the group parameters."
|
|
`(when (gnus-nnselect-group-p ,group)
|
|
(let ((override (gnus-group-get-parameter
|
|
,group
|
|
'nnselect-get-artlist-override-function)))
|
|
(cond
|
|
(override (funcall override ,group))
|
|
((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
|
|
nil)
|
|
(t
|
|
(nnselect-uncompress-artlist
|
|
(gnus-group-get-parameter ,group 'nnselect-artlist t)))))))
|
|
|
|
(defmacro nnselect-store-artlist (group artlist)
|
|
"Store the ARTLIST for GROUP.
|
|
If the group parameter `nnselect-store-artlist-override-function'
|
|
is non-nil call this function on GROUP and ARTLIST; if the group
|
|
parameter `nnselect-always-regenerate' is non-nil don't store the
|
|
artlist; otherwise store the ARTLIST in the group parameters.
|
|
The active range is also stored."
|
|
`(let ((override (gnus-group-get-parameter
|
|
,group
|
|
'nnselect-store-artlist-override-function)))
|
|
(gnus-group-set-parameter ,group 'active
|
|
(cons 1 (nnselect-artlist-length ,artlist)))
|
|
(cond
|
|
(override (funcall override ,group ,artlist))
|
|
((gnus-group-get-parameter ,group 'nnselect-always-regenerate)
|
|
(gnus-group-remove-parameter ,group 'nnselect-artlist))
|
|
(t
|
|
(gnus-group-set-parameter ,group 'nnselect-artlist
|
|
(nnselect-compress-artlist ,artlist))))))
|
|
|
|
(defun nnselect-generate-artlist (group &optional specs info)
|
|
"Generate and return the artlist for GROUP using SPECS.
|
|
The artlist is sorted by rsv, lexically over groups, and by
|
|
article number. SPECS should be an alist including an
|
|
`nnselect-function' and an `nnselect-args'. The former applied
|
|
to the latter should create the artlist. If SPECS is nil
|
|
retrieve the specs from the group parameters. If INFO update the
|
|
group info."
|
|
(let* ((specs
|
|
(or specs (gnus-group-get-parameter group 'nnselect-specs t)))
|
|
(function (alist-get 'nnselect-function specs))
|
|
(args (alist-get 'nnselect-args specs)))
|
|
(condition-case-unless-debug err
|
|
(progn
|
|
(let ((gnus-newsgroup-selection
|
|
(sort
|
|
(funcall function args)
|
|
(lambda (x y)
|
|
(let ((xgroup (nnselect-artitem-group x))
|
|
(ygroup (nnselect-artitem-group y))
|
|
(xrsv (nnselect-artitem-rsv x))
|
|
(yrsv (nnselect-artitem-rsv y)))
|
|
(or (< xrsv yrsv)
|
|
(and (eql xrsv yrsv)
|
|
(or (string< xgroup ygroup)
|
|
(and (string= xgroup ygroup)
|
|
(< (nnselect-artitem-number x)
|
|
(nnselect-artitem-number y)))))))))))
|
|
(when info
|
|
(if gnus-newsgroup-selection
|
|
(nnselect-request-update-info group info)
|
|
(gnus-set-active group '(1 . 0))))
|
|
(nnselect-store-artlist group gnus-newsgroup-selection)
|
|
gnus-newsgroup-selection))
|
|
;; Don't swallow gnus-search errors; the user should be made
|
|
;; aware of them.
|
|
(gnus-search-error
|
|
(signal (car err) (cdr err)))
|
|
(error
|
|
(gnus-error
|
|
3
|
|
"nnselect-generate-artlist: %s on %s gave error %s" function args err)
|
|
[]))))
|
|
|
|
;; Gnus backend interface functions.
|
|
|
|
(deffoo nnselect-open-server (server &optional definitions)
|
|
;; Just set the server variables appropriately.
|
|
(let ((backend (or (car (gnus-server-to-method server)) 'nnselect)))
|
|
(nnoo-change-server backend server definitions)))
|
|
|
|
;; (deffoo nnselect-server-opened (&optional server)
|
|
;; "Is SERVER the current virtual server?"
|
|
;; (if (string-empty-p server)
|
|
;; t
|
|
;; (let ((backend (car (gnus-server-to-method server))))
|
|
;; (nnoo-current-server-p (or backend 'nnselect) server))))
|
|
|
|
(deffoo nnselect-server-opened (&optional _server)
|
|
t)
|
|
|
|
|
|
(deffoo nnselect-request-group (group &optional _server _dont-check info)
|
|
(let* ((group (nnselect-add-prefix group))
|
|
(length (cdr (gnus-group-get-parameter group 'active t))))
|
|
(when (or (null length)
|
|
(gnus-group-get-parameter group 'nnselect-always-regenerate))
|
|
(setq length (nnselect-artlist-length
|
|
(nnselect-generate-artlist group nil info))))
|
|
(if (and (zerop length) (gnus-ephemeral-group-p group))
|
|
(progn
|
|
(nnheader-report 'nnselect "Selection produced empty results.")
|
|
(gnus-kill-ephemeral-group group)
|
|
(setq gnus-ephemeral-servers
|
|
(assq-delete-all 'nnselect gnus-ephemeral-servers))
|
|
(nnheader-insert ""))
|
|
(with-current-buffer nntp-server-buffer
|
|
(nnheader-insert "211 %d %d %d %s\n"
|
|
length ; total #
|
|
(if (zerop length) 0 1) ; first #
|
|
length ; last #
|
|
group))))) ; group name
|
|
|
|
(deffoo nnselect-retrieve-headers (articles group &optional _server fetch-old)
|
|
(let ((group (nnselect-add-prefix group))
|
|
(gnus-inhibit-demon t))
|
|
(with-current-buffer (gnus-summary-buffer-name group)
|
|
(setq gnus-newsgroup-selection
|
|
(or gnus-newsgroup-selection
|
|
(nnselect-get-artlist group)
|
|
;; maybe don't need to update the info?
|
|
;; (nnselect-generate-artlist group nil (gnus-get-info group))))
|
|
(nnselect-generate-artlist group)))
|
|
(let ((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))
|
|
(fetch-old
|
|
(or
|
|
(car-safe
|
|
(gnus-group-find-parameter artgroup
|
|
'gnus-fetch-old-headers t))
|
|
fetch-old)))
|
|
(gnus-request-group artgroup)
|
|
(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
|
|
(goto-char (point-min))
|
|
(while (not (eobp))
|
|
(nnselect-add-novitem
|
|
(nnheader-parse-nov))
|
|
(forward-line 1)))
|
|
('headers
|
|
(gnus-run-hooks 'gnus-parse-headers-hook)
|
|
(let ((nnmail-extra-headers gnus-extra-headers))
|
|
(goto-char (point-min))
|
|
(while (not (eobp))
|
|
(nnselect-add-novitem
|
|
(nnheader-parse-head))
|
|
(forward-line 1))))
|
|
((pred listp)
|
|
(dolist (novitem gnus-headers-retrieved-by)
|
|
(nnselect-add-novitem novitem)))
|
|
(_ (error "Unknown header type %s while requesting articles \
|
|
of group %s" gnus-headers-retrieved-by artgroup)))))
|
|
(setq headers
|
|
(sort
|
|
headers
|
|
(lambda (x y)
|
|
(< (mail-header-number x) (mail-header-number y))))))))))
|
|
|
|
|
|
(deffoo nnselect-request-article (article &optional _group server to-buffer)
|
|
(let* ((gnus-override-method nil)
|
|
servers group-art artlist)
|
|
(if (numberp article)
|
|
(with-current-buffer gnus-summary-buffer
|
|
(unless (zerop (nnselect-artlist-length
|
|
gnus-newsgroup-selection))
|
|
(setq group-art (cons (nnselect-article-group article)
|
|
(nnselect-article-number article)))))
|
|
;; message-id: either coming from a referral or a pseudo-article
|
|
;; find the servers for a pseudo-article
|
|
(if (eq 'nnselect (car (gnus-server-to-method server)))
|
|
(with-current-buffer gnus-summary-buffer
|
|
(let ((thread (gnus-id-to-thread article)))
|
|
(when (car thread)
|
|
(mapc
|
|
(lambda (x)
|
|
(when (and x (> x 0))
|
|
(cl-pushnew
|
|
(list
|
|
(gnus-method-to-server
|
|
(gnus-find-method-for-group
|
|
(nnselect-article-group x))))
|
|
servers :test 'equal)))
|
|
(gnus-articles-in-thread thread)))))
|
|
(setq servers (list (list server))))
|
|
(setq artlist
|
|
(gnus-search-run-query
|
|
(list
|
|
(cons 'search-query-spec
|
|
(list (cons 'query (format "id:%s" article))))
|
|
(cons 'search-group-spec servers))))
|
|
(unless (zerop (nnselect-artlist-length artlist))
|
|
(setq
|
|
group-art
|
|
(cons
|
|
(nnselect-artitem-group (nnselect-artlist-article artlist 1))
|
|
(nnselect-artitem-number (nnselect-artlist-article artlist 1))))))
|
|
(when (numberp (cdr group-art))
|
|
(message "Requesting article %d from group %s"
|
|
(cdr group-art) (car group-art))
|
|
(if to-buffer
|
|
(with-current-buffer to-buffer
|
|
(let ((gnus-article-decode-hook nil))
|
|
(gnus-request-article-this-buffer
|
|
(cdr group-art) (car group-art))))
|
|
(gnus-request-article (cdr group-art) (car group-art)))
|
|
group-art)))
|
|
|
|
|
|
(deffoo nnselect-request-move-article
|
|
(article _group _server accept-form &optional last _internal-move-group)
|
|
(let* ((nnimap-expunge 'immediately)
|
|
(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-replace-article
|
|
(article _group buffer &optional no-encode)
|
|
(pcase-let ((`[,artgroup ,artnumber ,artrsv]
|
|
(with-current-buffer gnus-summary-buffer
|
|
(nnselect-artlist-article gnus-newsgroup-selection article))))
|
|
(unless (gnus-check-backend-function
|
|
'request-replace-article artgroup)
|
|
(user-error "The group %s does not support article editing" artgroup))
|
|
(let ((newart
|
|
(gnus-request-replace-article artnumber artgroup buffer no-encode)))
|
|
(with-current-buffer gnus-summary-buffer
|
|
(cl-nsubstitute `[,artgroup ,newart ,artrsv]
|
|
`[,artgroup ,artnumber ,artrsv]
|
|
gnus-newsgroup-selection
|
|
:test #'equal :count 1)))))
|
|
|
|
(deffoo nnselect-request-expire-articles
|
|
(articles group &optional _server force)
|
|
(let ((nnimap-expunge 'immediately) not-deleted)
|
|
(if (and (not force)
|
|
(not nnselect-allow-ephemeral-expiry)
|
|
(gnus-ephemeral-group-p (nnselect-add-prefix group)))
|
|
articles
|
|
(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))
|
|
(setq not-deleted
|
|
(append
|
|
(mapcar (lambda (art) (car (rassq art artids)))
|
|
(gnus-request-expire-articles artlist artgroup
|
|
force))
|
|
not-deleted))))
|
|
(sort (delq nil not-deleted) #'<))))
|
|
|
|
|
|
(deffoo nnselect-warp-to-article ()
|
|
(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)
|
|
(mapc
|
|
(lambda (request) (gnus-request-set-mark (car request) (cdr request)))
|
|
(nnselect-categorize
|
|
(cl-mapcan
|
|
(lambda (act)
|
|
(cl-destructuring-bind (range action marks) act
|
|
(mapcar
|
|
(lambda (artgroup)
|
|
(list (car artgroup)
|
|
(gnus-compress-sequence (sort (cdr artgroup) #'<))
|
|
action marks))
|
|
(numbers-by-group range 'range))))
|
|
actions)
|
|
#'car #'cdr)))
|
|
|
|
(deffoo nnselect-request-update-info (group info &optional _server)
|
|
(let* ((group (nnselect-add-prefix group))
|
|
(gnus-newsgroup-selection
|
|
(or gnus-newsgroup-selection (nnselect-get-artlist group)))
|
|
newmarks)
|
|
(when gnus-newsgroup-selection
|
|
(gnus-info-set-marks info nil)
|
|
(setf (gnus-info-read info) nil)
|
|
(pcase-dolist (`(,artgroup . ,nartids)
|
|
(ids-by-group
|
|
(number-sequence 1 (nnselect-artlist-length
|
|
gnus-newsgroup-selection))))
|
|
(let* ((gnus-newsgroup-active nil)
|
|
(idmap (make-hash-table :test 'eql))
|
|
(gactive (sort (mapcar 'cdr nartids) #'<))
|
|
(group-info (gnus-get-info artgroup))
|
|
(marks (gnus-info-marks group-info)))
|
|
(pcase-dolist (`(,val . ,key) nartids)
|
|
(puthash key val idmap))
|
|
(setf (gnus-info-read info)
|
|
(range-add-list
|
|
(gnus-info-read info)
|
|
(sort (mapcar (lambda (art) (gethash art idmap))
|
|
(gnus-sorted-intersection
|
|
gactive
|
|
(range-uncompress (gnus-info-read group-info))))
|
|
#'<)))
|
|
(pcase-dolist (`(,type . ,mark-list) marks)
|
|
(let ((mark-type (gnus-article-mark-to-type type)) new)
|
|
(when
|
|
(setq new
|
|
(if (not mark-list) nil
|
|
(cond
|
|
((eq mark-type 'tuple)
|
|
(delq nil
|
|
(mapcar
|
|
(lambda (mark)
|
|
(let ((id (gethash (car mark) idmap)))
|
|
(when id (cons id (cdr mark)))))
|
|
mark-list)))
|
|
(t
|
|
(mapcar (lambda (art) (gethash art idmap))
|
|
(gnus-sorted-intersection
|
|
gactive (range-uncompress mark-list)))))))
|
|
(let ((previous (alist-get type newmarks)))
|
|
(if previous
|
|
(nconc previous new)
|
|
(push (cons type new) newmarks))))))))
|
|
|
|
;; Clean up the marks: compress lists;
|
|
(pcase-dolist (`(,type . ,mark-list) newmarks)
|
|
(let ((mark-type (gnus-article-mark-to-type type)))
|
|
(unless (eq mark-type 'tuple)
|
|
(setf (alist-get type newmarks)
|
|
(gnus-compress-sequence (sort mark-list #'<))))))
|
|
;; and ensure an unexist key.
|
|
(unless (assq 'unexist newmarks)
|
|
(push (cons 'unexist nil) newmarks))
|
|
|
|
(gnus-info-set-marks info newmarks)
|
|
(gnus-set-active group (cons 1 (nnselect-artlist-length
|
|
gnus-newsgroup-selection))))))
|
|
|
|
|
|
(deffoo nnselect-request-thread (header &optional group server)
|
|
(with-current-buffer gnus-summary-buffer
|
|
(let* ((group (nnselect-add-prefix group))
|
|
;; Find the best group for the originating article. If its
|
|
;; a pseudo-article check for real articles in the same
|
|
;; thread to see where they come from.
|
|
(artgroup
|
|
(nnselect-article-group
|
|
(cond
|
|
((> (mail-header-number header) 0)
|
|
(mail-header-number header))
|
|
((> (gnus-summary-article-number) 0)
|
|
(gnus-summary-article-number))
|
|
(t (cl-some
|
|
(lambda (x) (when (and x (> x 0)) x))
|
|
(gnus-articles-in-thread
|
|
(gnus-id-to-thread (mail-header-id header))))))))
|
|
(server (or server (gnus-group-server artgroup))))
|
|
;; Check if search-based thread referral is available.
|
|
(if (ignore-errors (gnus-search-server-to-engine server))
|
|
;; We perform the query, massage the result, and return
|
|
;; the new headers back to the caller to incorporate into
|
|
;; the current summary buffer.
|
|
(let* ((gnus-search-use-parsed-queries t)
|
|
(group-spec
|
|
(if (not gnus-refer-thread-use-search)
|
|
(list (list server artgroup))
|
|
(if (listp gnus-refer-thread-use-search)
|
|
gnus-refer-thread-use-search
|
|
(list (list server)))))
|
|
(ids (cons (mail-header-id header)
|
|
(split-string
|
|
(or (mail-header-references header)
|
|
""))))
|
|
(query-spec
|
|
(list (cons 'query
|
|
(mapconcat (lambda (i) (format "id:%s" i))
|
|
ids " or ")) (cons 'thread t)))
|
|
(last (nnselect-artlist-length gnus-newsgroup-selection))
|
|
(first (1+ last))
|
|
old-arts seq headers)
|
|
(mapc
|
|
(lambda (article)
|
|
(if (setq seq
|
|
(cl-position
|
|
article
|
|
gnus-newsgroup-selection
|
|
:test
|
|
(lambda (x y)
|
|
(and (equal (nnselect-artitem-group x)
|
|
(nnselect-artitem-group y))
|
|
(eql (nnselect-artitem-number x)
|
|
(nnselect-artitem-number y))))))
|
|
(push (1+ seq) old-arts)
|
|
(setq gnus-newsgroup-selection
|
|
(vconcat gnus-newsgroup-selection (vector article)))
|
|
(cl-incf last)))
|
|
(gnus-search-run-query
|
|
(list (cons 'search-query-spec query-spec)
|
|
(cons 'search-group-spec group-spec))))
|
|
(setq headers
|
|
(gnus-fetch-headers
|
|
(append (sort old-arts #'<) (number-sequence first last))
|
|
nil t))
|
|
(nnselect-store-artlist group gnus-newsgroup-selection)
|
|
(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)))
|
|
(when
|
|
(setq new-marks
|
|
(delq nil
|
|
(if (eq (gnus-article-mark-to-type type)
|
|
'tuple)
|
|
(mapcar
|
|
(lambda (art)
|
|
(let ((mtup
|
|
(assq (cdr art) marked)))
|
|
(when mtup
|
|
(cons (car art) (cdr mtup)))))
|
|
artids)
|
|
(setq marked
|
|
(gnus-uncompress-sequence marked))
|
|
(mapcar
|
|
(lambda (art)
|
|
(when (memq (cdr art) marked)
|
|
(car art)))
|
|
artids))))
|
|
(nconc
|
|
(symbol-value
|
|
(intern
|
|
(format "gnus-newsgroup-%s"
|
|
(car
|
|
(rassq type gnus-article-mark-lists)))))
|
|
new-marks)))))
|
|
(gnus-set-active
|
|
group
|
|
(setq
|
|
gnus-newsgroup-active
|
|
(cons 1 (nnselect-artlist-length gnus-newsgroup-selection)))))
|
|
headers)
|
|
;; If we can't use search, just warp to the original 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-add-prefix group)))
|
|
(unless gnus-group-is-exiting-without-update-p
|
|
(when gnus-newsgroup-selection
|
|
(nnselect-push-info group)))
|
|
(setq gnus-newsgroup-selection 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))
|
|
(artlist (alist-get 'nnselect-artlist args))
|
|
(otherargs (assq-delete-all 'nnselect-specs args))
|
|
(function-spec
|
|
(or (alist-get 'nnselect-function specs)
|
|
(intern (completing-read "Function: " obarray #'functionp))))
|
|
(args-spec
|
|
(or (alist-get 'nnselect-args specs)
|
|
(read-from-minibuffer "Args: " nil nil t nil "nil")))
|
|
(nnselect-specs (list (cons 'nnselect-function function-spec)
|
|
(cons 'nnselect-args args-spec))))
|
|
(gnus-group-set-parameter group 'nnselect-specs nnselect-specs)
|
|
(dolist (arg otherargs)
|
|
(gnus-group-set-parameter group (car arg) (cdr arg)))
|
|
(if artlist
|
|
(nnselect-store-artlist group artlist)
|
|
(nnselect-generate-artlist group nnselect-specs
|
|
(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-rename-group (_group _new-name &optional _server)
|
|
t)
|
|
|
|
|
|
(deffoo nnselect-request-scan (group _method)
|
|
(when (and group
|
|
(gnus-group-find-parameter (nnselect-add-prefix group)
|
|
'nnselect-rescan t))
|
|
(nnselect-request-group-scan group)))
|
|
|
|
|
|
(deffoo nnselect-request-group-scan (group &optional _server _info)
|
|
(let ((group (nnselect-add-prefix group)))
|
|
(unless (gnus-group-find-parameter group 'nnselect-always-regenerate)
|
|
(let ((artlist (nnselect-generate-artlist group)))
|
|
(gnus-set-active group (cons 1 (nnselect-artlist-length
|
|
artlist))))))
|
|
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-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* ((ids (cons (mail-header-id header)
|
|
(split-string
|
|
(or (mail-header-references header)
|
|
""))))
|
|
(query
|
|
(list (cons 'query (mapconcat (lambda (i)
|
|
(format "id:%s" i))
|
|
ids " or "))
|
|
(cons 'thread t)))
|
|
(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 'gnus-search-run-query)
|
|
(cons 'nnselect-args
|
|
(list (cons 'search-query-spec query)
|
|
(cons 'search-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 mark-lists from GROUP to the originating groups."
|
|
(let ((select-unreads (numbers-by-group gnus-newsgroup-unreads))
|
|
(select-reads (numbers-by-group
|
|
(gnus-sorted-difference gnus-newsgroup-articles
|
|
gnus-newsgroup-unreads)))
|
|
(select-unseen (numbers-by-group gnus-newsgroup-unseen))
|
|
(quit-config (gnus-group-quit-config group))
|
|
(gnus-newsgroup-active nil) mark-list)
|
|
;; collect the set of marked article lists categorized by
|
|
;; originating groups
|
|
(pcase-dolist (`(,mark . ,type) gnus-article-mark-lists)
|
|
(let ((mark-type (gnus-article-mark-to-type type))
|
|
(type-list (symbol-value
|
|
(intern (format "gnus-newsgroup-%s" mark)))))
|
|
(when type-list
|
|
(unless (eq 'tuple mark-type)
|
|
(setq type-list (range-list-intersection
|
|
gnus-newsgroup-articles type-list)))
|
|
(push (cons type (numbers-by-group type-list mark-type))
|
|
mark-list))))
|
|
;; now work on each originating group one at a time
|
|
(pcase-dolist (`(,artgroup . ,artlist)
|
|
(numbers-by-group gnus-newsgroup-articles))
|
|
(setq artlist (sort artlist #'<))
|
|
(let ((group-info (gnus-get-info artgroup))
|
|
(old-unread (gnus-list-of-unread-articles artgroup))
|
|
(rsm (gnus-check-backend-function 'request-set-mark artgroup))
|
|
newmarked delta-marks)
|
|
(when group-info
|
|
;; iterate over mark lists for this group
|
|
(pcase-dolist (`(,_mark . ,type) gnus-article-mark-lists)
|
|
(let ((list (cdr (assoc artgroup (alist-get type mark-list))))
|
|
(mark-type (gnus-article-mark-to-type type))
|
|
(group-marks (alist-get type (gnus-info-marks group-info))))
|
|
|
|
;; When the backend can store marks we collect any
|
|
;; changes. Unlike a normal group the mark lists only
|
|
;; include marks for articles we retrieved. If there is
|
|
;; no quit-config then gnus-update-marks has already
|
|
;; been called to handle this.
|
|
(when (and quit-config rsm
|
|
(not (gnus-article-unpropagatable-p type)))
|
|
(let* ((old (range-list-intersection
|
|
artlist group-marks))
|
|
(del (range-remove (copy-tree old) list))
|
|
(add (range-remove (copy-tree list) old)))
|
|
(when add (push (list add 'add (list type)) delta-marks))
|
|
(when del
|
|
;; Don't delete marks from outside the active range.
|
|
;; This shouldn't happen, but is a sanity check.
|
|
(setq del (range-intersection (gnus-active artgroup) del))
|
|
(push (list del 'del (list type)) delta-marks))))
|
|
|
|
;; Marked sets are of mark-type 'tuple, 'list, or
|
|
;; 'range. We merge the lists with what is already in
|
|
;; the original info to get full list of new marks. We
|
|
;; do this by removing all the articles we retrieved
|
|
;; from the full list, and then add back in the newly
|
|
;; marked ones.
|
|
(cond
|
|
((eq mark-type 'tuple)
|
|
;; Get rid of the entries that have the default
|
|
;; score.
|
|
(when (and list (eq type 'score) gnus-save-score)
|
|
(let* ((arts list)
|
|
(prev (cons nil list))
|
|
(all prev))
|
|
(while arts
|
|
(if (or (not (consp (car arts)))
|
|
(= (cdar arts) gnus-summary-default-score))
|
|
(setcdr prev (cdr arts))
|
|
(setq prev arts))
|
|
(setq arts (cdr arts)))
|
|
(setq list (cdr all))))
|
|
;; now merge with the original list and sort just to
|
|
;; make sure
|
|
(setq list
|
|
(sort
|
|
(map-merge
|
|
'alist list
|
|
(delq nil
|
|
(mapcar
|
|
(lambda (x) (unless (memq (car x) artlist) x))
|
|
group-marks)))
|
|
'car-less-than-car)))
|
|
(t
|
|
(setq list
|
|
(range-compress-list
|
|
(gnus-sorted-union
|
|
(gnus-sorted-difference
|
|
(gnus-uncompress-sequence group-marks)
|
|
artlist)
|
|
(sort list #'<))))
|
|
|
|
;; When exiting the group, everything that's previously been
|
|
;; unseen is now seen.
|
|
(when (eq type 'seen)
|
|
(setq list (range-concat
|
|
list (cdr (assoc artgroup select-unseen)))))))
|
|
|
|
(when (or list (eq type 'unexist))
|
|
(push (cons type list) newmarked)))) ;; end of mark-type loop
|
|
(when delta-marks
|
|
(unless (gnus-check-group artgroup)
|
|
(error "Can't open server for %s" artgroup))
|
|
(gnus-request-set-mark artgroup delta-marks))
|
|
(gnus-atomic-progn
|
|
(gnus-info-set-marks group-info 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 (cl-decf i) group-info)
|
|
(setcdr (nthcdr i group-info) nil))))
|
|
|
|
;; update read and unread
|
|
(gnus-update-read-articles
|
|
artgroup
|
|
(range-uncompress
|
|
(range-add-list
|
|
(range-remove
|
|
old-unread
|
|
(cdr (assoc artgroup select-reads)))
|
|
(sort (cdr (assoc artgroup select-unreads)) #'<)))))
|
|
(gnus-get-unread-articles-in-group
|
|
group-info (gnus-active artgroup) t)
|
|
(gnus-group-update-group
|
|
artgroup t
|
|
(equal group-info
|
|
(setq group-info (copy-sequence (gnus-get-info artgroup))
|
|
group-info
|
|
(delq (gnus-info-params group-info) group-info)))))))))
|
|
|
|
(declare-function gnus-registry-get-id-key "gnus-registry" (id key))
|
|
|
|
(defun gnus-summary-make-search-group (no-parse)
|
|
"Search a group from the summary buffer.
|
|
Pass NO-PARSE on to the search engine."
|
|
(interactive "P")
|
|
(gnus-warp-to-article)
|
|
(let ((spec
|
|
(list
|
|
(cons 'search-group-spec
|
|
(list (list
|
|
(gnus-group-server gnus-newsgroup-name)
|
|
gnus-newsgroup-name))))))
|
|
(gnus-group-make-search-group no-parse spec)))
|
|
|
|
|
|
(provide 'nnselect)
|
|
|
|
;;; nnselect.el ends here
|