;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994-2000 Free Software Foundation, Inc.
+
+;; Copyright (C) 1994-2014 Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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 2, or (at your option)
-;; any later version.
+;; 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
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
(nnoo-declare nnvirtual)
(defvoo nnvirtual-always-rescan t
- "*If non-nil, always scan groups for unread articles when entering a group.
+ "If non-nil, always scan groups for unread articles when entering a group.
If this variable is nil and you read articles in a component group
after the virtual group has been activated, the read articles from the
component group will show up when you enter the virtual group.")
(defvoo nnvirtual-component-regexp nil
- "*Regexp to match component groups.")
+ "Regexp to match component groups.")
(defvoo nnvirtual-component-groups nil
"Component group in this nnvirtual group.")
(defvoo nnvirtual-status-string "")
-(eval-and-compile
- (autoload 'gnus-cache-articles-in-group "gnus-cache"))
+(autoload 'gnus-cache-articles-in-group "gnus-cache")
\f
(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
server fetch-old)
(when (nnvirtual-possibly-change-server server)
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(if (stringp (car articles))
'headers
;; the nntp-server-buffer, which is where Gnus expects to find
;; them.
(prog1
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(erase-buffer)
(insert-buffer-substring vbuf)
;; FIX FIX FIX, we should be able to sort faster than
(when buffer
(set-buffer buffer))
(let* ((gnus-override-method nil)
- (method (gnus-find-method-for-group
- nnvirtual-last-accessed-component-group)))
- (funcall (gnus-get-function method 'request-article)
- article nil (nth 1 method) buffer)))))
+ (gnus-command-method
+ (gnus-find-method-for-group
+ nnvirtual-last-accessed-component-group)))
+ (funcall (gnus-get-function gnus-command-method 'request-article)
+ article nil (nth 1 gnus-command-method) buffer)))))
;; This is a fetch by number.
(let* ((amap (nnvirtual-map-article article))
(cgroup (car amap)))
(t
(setq nnvirtual-last-accessed-component-group cgroup)
(if buffer
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
;; We bind this here to avoid double decoding.
(let ((gnus-article-decode-hook nil))
(gnus-request-article-this-buffer (cdr amap) cgroup)))
t)))
-(deffoo nnvirtual-request-group (group &optional server dont-check)
+(deffoo nnvirtual-request-group (group &optional server dont-check info)
(nnvirtual-possibly-change-server server)
(setq nnvirtual-component-groups
(delete (nnvirtual-current-group) nnvirtual-component-groups))
(nnheader-report 'nnvirtual "No component groups in %s" group))
(t
(setq nnvirtual-current-group group)
- (when (or (not dont-check)
- nnvirtual-always-rescan)
- (nnvirtual-create-mapping)
- (when nnvirtual-always-rescan
- (nnvirtual-request-update-info
- (nnvirtual-current-group)
- (gnus-get-info (nnvirtual-current-group)))))
+ (nnvirtual-create-mapping dont-check)
+ (when nnvirtual-always-rescan
+ (nnvirtual-request-update-info
+ (nnvirtual-current-group)
+ (gnus-get-info (nnvirtual-current-group))))
(nnheader-insert "211 %d 1 %d %s\n"
nnvirtual-mapping-len nnvirtual-mapping-len group))))
t)
-(deffoo nnvirtual-request-list (&optional server)
- (nnheader-report 'nnvirtual "LIST is not implemented."))
-
-
(deffoo nnvirtual-request-newgroups (date &optional server)
(nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
(let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
(gnus-expert-user t))
;; Make sure all groups are activated.
- (mapcar
+ (mapc
(lambda (g)
- (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
+ (when (not (numberp (gnus-group-unread g)))
(gnus-activate-group g)))
nnvirtual-component-groups)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(gnus-group-catchup-current nil all)))))
(gnus-request-post (gnus-find-method-for-group group)))))
-(deffoo nnvirtual-request-expire-articles (articles group
+(deffoo nnvirtual-request-expire-articles (articles group
&optional server force)
(nnvirtual-possibly-change-server server)
(setq nnvirtual-component-groups
(delete (nnvirtual-current-group) nnvirtual-component-groups))
- (dolist (group nnvirtual-component-groups)
- (gnus-group-expire-articles-1 group)))
+ (let (unexpired)
+ (dolist (group nnvirtual-component-groups)
+ (setq unexpired (nconc unexpired
+ (mapcar
+ #'(lambda (article)
+ (nnvirtual-reverse-map-article
+ group article))
+ (gnus-uncompress-range
+ (gnus-group-expire-articles-1 group))))))
+ (sort (delq nil unexpired) '<)))
\f
;;; Internal functions.
(defun nnvirtual-convert-headers ()
"Convert HEAD headers into NOV headers."
- (save-excursion
- (set-buffer nntp-server-buffer)
+ (with-current-buffer nntp-server-buffer
(let* ((dependencies (make-vector 100 0))
- (headers (gnus-get-newsgroup-headers dependencies))
- header)
+ (headers (gnus-get-newsgroup-headers dependencies)))
(erase-buffer)
- (while (setq header (pop headers))
- (nnheader-insert-nov header)))))
+ (mapc 'nnheader-insert-nov headers))))
(defun nnvirtual-update-xref-header (group article prefix system-name)
(looking-at
"[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
(goto-char (match-end 0))
- (unless (search-forward "\t" (gnus-point-at-eol) 'move)
+ (unless (search-forward "\t" (point-at-eol) 'move)
(insert "\t"))
;; Remove any spaces at the beginning of the Xref field.
;; component server prefix.
(save-restriction
(narrow-to-region (point)
- (or (search-forward "\t" (gnus-point-at-eol) t)
- (gnus-point-at-eol)))
+ (or (search-forward "\t" (point-at-eol) t)
+ (point-at-eol)))
(goto-char (point-min))
(when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
(replace-match "" t t))
(concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
nil t)
(replace-match "" t t))
- (unless (= (point) (point-max))
+ (unless (eobp)
(insert " ")
(when (not (string= "" prefix))
(while (re-search-forward "[^ ]+:[0-9]+" nil t)
(nnvirtual-partition-sequence (cdr ml)))))
(gnus-info-marks (gnus-get-info
(nnvirtual-current-group))))))
- mark type groups carticles info entry)
+ type groups info)
;; Ok, atomically move all of the (un)read info, clear any old
;; marks, and move all of the current marks. This way if someone
;; move (un)read
;; bind for workaround guns-update-read-articles
(let ((gnus-newsgroup-active nil))
- (while (setq entry (pop unreads))
+ (dolist (entry unreads)
(gnus-update-read-articles (car entry) (cdr entry))))
;; clear all existing marks on the component groups
- (setq groups nnvirtual-component-groups)
- (while groups
- (when (and (setq info (gnus-get-info (pop groups)))
+ (dolist (group nnvirtual-component-groups)
+ (when (and (setq info (gnus-get-info group))
(gnus-info-marks info))
(gnus-info-set-marks
info
;; Ok, currently type-marks is an assq list with keys of a mark type,
;; with data of an assq list with keys of component group names
;; and the articles which correspond to that key/group pair.
- (while (setq mark (pop type-marks))
+ (dolist (mark type-marks)
(setq type (car mark))
(setq groups (cdr mark))
- (while (setq carticles (pop groups))
+ (dolist (carticles groups)
(gnus-add-marked-articles (car carticles) type (cdr carticles)
nil t))))
;; possibly update the display, it is really slow
(when update-p
- (setq groups nnvirtual-component-groups)
- (while groups
- (gnus-group-update-group (pop groups) t))))))
+ (dolist (group nnvirtual-component-groups)
+ (gnus-group-update-group group t))))))
(defun nnvirtual-current-group ()
;;; We map between virtual articles and real articles in a manner
-;;; which keeps the size of the virtual active list the same as
-;;; the sum of the component active lists.
-;;; To achieve fair mixing of the groups, the last article in
-;;; each of N component groups will be in the the last N articles
-;;; in the virtual group.
-
-;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
-;;; resprectively, then the virtual article numbers look like:
+;;; which keeps the size of the virtual active list the same as the
+;;; sum of the component active lists.
+
+;;; To achieve fair mixing of the groups, the last article in each of
+;;; N component groups will be in the last N articles in the virtual
+;;; group.
+
+;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and
+;;; 6-7 respectively, then the virtual article numbers look like:
;;;
;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
the result."
(when (numberp (cdr-safe articles))
(setq articles (list articles)))
- (let ((carticles (mapcar (lambda (g) (list g))
- nnvirtual-component-groups))
+ (let ((carticles (mapcar 'list nnvirtual-component-groups))
a i j article entry)
(while (setq a (pop articles))
(if (atom a)
(setq entry (assoc (car article) carticles))
(setcdr entry (cons (cdr article) (cdr entry))))
(setq i (1+ i))))
- (mapcar (lambda (x) (setcdr x (nreverse (cdr x))))
- carticles)
+ (mapc (lambda (x) (setcdr x (nreverse (cdr x))))
+ carticles)
carticles))
-(defun nnvirtual-create-mapping ()
+(defun nnvirtual-create-mapping (dont-check)
"Build the tables necessary to map between component (group, article) to virtual article.
Generate the set of read messages and marks for the virtual group
based on the marks on the component groups."
;; Into all-unreads we put (g unreads).
;; Into all-marks we put (g marks).
;; We also increment cnt and tot here, and compute M (max of sizes).
- (mapcar (lambda (g)
- (setq active (gnus-activate-group g)
- min (car active)
- max (cdr active))
- (when (and active (>= max min) (not (zerop max)))
- ;; store active information
- (push (list g (- max min -1) max) actives)
- ;; collect unread/mark info for later
- (setq unreads (gnus-list-of-unread-articles g))
- (setq marks (gnus-info-marks (gnus-get-info g)))
- (when gnus-use-cache
- (push (cons 'cache
- (gnus-cache-articles-in-group g))
- marks))
- (push (cons g unreads) all-unreads)
- (push (cons g marks) all-marks)
- ;; count groups, total #articles, and max size
- (setq size (- max min -1))
- (setq cnt (1+ cnt)
- tot (+ tot size)
- M (max M size))))
- nnvirtual-component-groups)
+ (mapc (lambda (g)
+ (setq active (or (and dont-check
+ (gnus-active g))
+ (gnus-activate-group g))
+ min (car active)
+ max (cdr active))
+ (when (and active (>= max min) (not (zerop max)))
+ ;; store active information
+ (push (list g (- max min -1) max) actives)
+ ;; collect unread/mark info for later
+ (setq unreads (gnus-list-of-unread-articles g))
+ (setq marks (gnus-info-marks (gnus-get-info g)))
+ (when gnus-use-cache
+ (push (cons 'cache
+ (gnus-cache-articles-in-group g))
+ marks))
+ (push (cons g unreads) all-unreads)
+ (push (cons g marks) all-marks)
+ ;; count groups, total #articles, and max size
+ (setq size (- max min -1))
+ (setq cnt (1+ cnt)
+ tot (+ tot size)
+ M (max M size))))
+ nnvirtual-component-groups)
;; Number of articles in the virtual group.
(setq nnvirtual-mapping-len tot)
;; Remove any empty marks lists, and store.
(setq nnvirtual-mapping-marks nil)
- (while marks
- (if (cdr (car marks))
- (push (car marks) nnvirtual-mapping-marks))
- (setq marks (cdr marks)))
+ (dolist (mark marks)
+ (when (cdr mark)
+ (push mark nnvirtual-mapping-marks)))
;; We need to convert the unreads to reads. We compress the
;; sequence as we go, otherwise it could be huge.
projects / gnus / blobdiff