mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-27 07:37:33 +00:00
775 lines
26 KiB
EmacsLisp
775 lines
26 KiB
EmacsLisp
;;; nnvirtual.el --- virtual newsgroups access for Gnus
|
||
;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
|
||
|
||
;; Author: David Moore <dmoore@ucsd.edu>
|
||
;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
|
||
;; 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
|
||
;; 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.
|
||
|
||
;; 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; see the file COPYING. If not, write to the
|
||
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||
;; Boston, MA 02111-1307, USA.
|
||
|
||
;;; Commentary:
|
||
|
||
;; The other access methods (nntp, nnspool, etc) are general news
|
||
;; access methods. This module relies on Gnus and can not be used
|
||
;; separately.
|
||
|
||
;;; Code:
|
||
|
||
(require 'nntp)
|
||
(require 'nnheader)
|
||
(require 'gnus)
|
||
(require 'nnoo)
|
||
(require 'gnus-util)
|
||
(require 'gnus-start)
|
||
(require 'gnus-sum)
|
||
(eval-when-compile (require 'cl))
|
||
|
||
(nnoo-declare nnvirtual)
|
||
|
||
(defvoo nnvirtual-always-rescan nil
|
||
"*If non-nil, always scan groups for unread articles when entering a group.
|
||
If this variable is nil (which is the default) 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.")
|
||
|
||
(defvoo nnvirtual-component-groups nil
|
||
"Component group in this nnvirtual group.")
|
||
|
||
|
||
|
||
(defconst nnvirtual-version "nnvirtual 1.1")
|
||
|
||
(defvoo nnvirtual-current-group nil)
|
||
|
||
(defvoo nnvirtual-mapping-table nil
|
||
"Table of rules on how to map between component group and article number
|
||
to virtual article number.")
|
||
|
||
(defvoo nnvirtual-mapping-offsets nil
|
||
"Table indexed by component group to an offset to be applied to article numbers in that group.")
|
||
|
||
(defvoo nnvirtual-mapping-len 0
|
||
"Number of articles in this virtual group.")
|
||
|
||
(defvoo nnvirtual-mapping-reads nil
|
||
"Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
|
||
|
||
(defvoo nnvirtual-mapping-marks nil
|
||
"Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
|
||
|
||
(defvoo nnvirtual-info-installed nil
|
||
"T if we have already installed the group info for this group, and shouldn't blast over it again.")
|
||
|
||
(defvoo nnvirtual-status-string "")
|
||
|
||
(eval-and-compile
|
||
(autoload 'gnus-cache-articles-in-group "gnus-cache"))
|
||
|
||
|
||
|
||
;;; Interface functions.
|
||
|
||
(nnoo-define-basics nnvirtual)
|
||
|
||
|
||
(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
|
||
server fetch-old)
|
||
(when (nnvirtual-possibly-change-server server)
|
||
(save-excursion
|
||
(set-buffer nntp-server-buffer)
|
||
(erase-buffer)
|
||
(if (stringp (car articles))
|
||
'headers
|
||
(let ((vbuf (nnheader-set-temp-buffer
|
||
(get-buffer-create " *virtual headers*")))
|
||
(carticles (nnvirtual-partition-sequence articles))
|
||
(system-name (system-name))
|
||
cgroup carticle article result prefix)
|
||
(while carticles
|
||
(setq cgroup (caar carticles))
|
||
(setq articles (cdar carticles))
|
||
(pop carticles)
|
||
(when (and articles
|
||
(gnus-check-server
|
||
(gnus-find-method-for-group cgroup) t)
|
||
(gnus-request-group cgroup t)
|
||
(setq prefix (gnus-group-real-prefix cgroup))
|
||
;; FIX FIX FIX we want to check the cache!
|
||
;; This is probably evil if people have set
|
||
;; gnus-use-cache to nil themselves, but I
|
||
;; have no way of finding the true value of it.
|
||
(let ((gnus-use-cache t))
|
||
(setq result (gnus-retrieve-headers
|
||
articles cgroup nil))))
|
||
(set-buffer nntp-server-buffer)
|
||
;; If we got HEAD headers, we convert them into NOV
|
||
;; headers. This is slow, inefficient and, come to think
|
||
;; of it, downright evil. So sue me. I couldn't be
|
||
;; bothered to write a header parse routine that could
|
||
;; parse a mixed HEAD/NOV buffer.
|
||
(when (eq result 'headers)
|
||
(nnvirtual-convert-headers))
|
||
(goto-char (point-min))
|
||
(while (not (eobp))
|
||
(delete-region (point)
|
||
(progn
|
||
(setq carticle (read nntp-server-buffer))
|
||
(point)))
|
||
|
||
;; We remove this article from the articles list, if
|
||
;; anything is left in the articles list after going through
|
||
;; the entire buffer, then those articles have been
|
||
;; expired or canceled, so we appropriately update the
|
||
;; component group below. They should be coming up
|
||
;; generally in order, so this shouldn't be slow.
|
||
(setq articles (delq carticle articles))
|
||
|
||
(setq article (nnvirtual-reverse-map-article cgroup carticle))
|
||
(if (null article)
|
||
;; This line has no reverse mapping, that means it
|
||
;; was an extra article reference returned by nntp.
|
||
(progn
|
||
(beginning-of-line)
|
||
(delete-region (point) (progn (forward-line 1) (point))))
|
||
;; Otherwise insert the virtual article number,
|
||
;; and clean up the xrefs.
|
||
(princ article nntp-server-buffer)
|
||
(nnvirtual-update-xref-header cgroup carticle
|
||
prefix system-name)
|
||
(forward-line 1))
|
||
)
|
||
|
||
(set-buffer vbuf)
|
||
(goto-char (point-max))
|
||
(insert-buffer-substring nntp-server-buffer))
|
||
;; Anything left in articles is expired or canceled.
|
||
;; Could be smart and not tell it about articles already known?
|
||
(when articles
|
||
(gnus-group-make-articles-read cgroup articles))
|
||
)
|
||
|
||
;; The headers are ready for reading, so they are inserted into
|
||
;; the nntp-server-buffer, which is where Gnus expects to find
|
||
;; them.
|
||
(prog1
|
||
(save-excursion
|
||
(set-buffer nntp-server-buffer)
|
||
(erase-buffer)
|
||
(insert-buffer-substring vbuf)
|
||
;; FIX FIX FIX, we should be able to sort faster than
|
||
;; this if needed, since each cgroup is sorted, we just
|
||
;; need to merge
|
||
(sort-numeric-fields 1 (point-min) (point-max))
|
||
'nov)
|
||
(kill-buffer vbuf)))))))
|
||
|
||
|
||
(defvoo nnvirtual-last-accessed-component-group nil)
|
||
|
||
(deffoo nnvirtual-request-article (article &optional group server buffer)
|
||
(when (nnvirtual-possibly-change-server server)
|
||
(if (stringp article)
|
||
;; This is a fetch by Message-ID.
|
||
(cond
|
||
((not nnvirtual-last-accessed-component-group)
|
||
(nnheader-report
|
||
'nnvirtual "Don't know what server to request from"))
|
||
(t
|
||
(save-excursion
|
||
(when buffer
|
||
(set-buffer buffer))
|
||
(let ((method (gnus-find-method-for-group
|
||
nnvirtual-last-accessed-component-group)))
|
||
(funcall (gnus-get-function method 'request-article)
|
||
article nil (nth 1 method) buffer)))))
|
||
;; This is a fetch by number.
|
||
(let* ((amap (nnvirtual-map-article article))
|
||
(cgroup (car amap)))
|
||
(cond
|
||
((not amap)
|
||
(nnheader-report 'nnvirtual "No such article: %s" article))
|
||
((not (gnus-check-group cgroup))
|
||
(nnheader-report
|
||
'nnvirtual "Can't open server where %s exists" cgroup))
|
||
((not (gnus-request-group cgroup t))
|
||
(nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
|
||
(t
|
||
(setq nnvirtual-last-accessed-component-group cgroup)
|
||
(if buffer
|
||
(save-excursion
|
||
(set-buffer buffer)
|
||
(gnus-request-article-this-buffer (cdr amap) cgroup))
|
||
(gnus-request-article (cdr amap) cgroup))))))))
|
||
|
||
|
||
(deffoo nnvirtual-open-server (server &optional defs)
|
||
(unless (assq 'nnvirtual-component-regexp defs)
|
||
(push `(nnvirtual-component-regexp ,server)
|
||
defs))
|
||
(nnoo-change-server 'nnvirtual server defs)
|
||
(if nnvirtual-component-groups
|
||
t
|
||
(setq nnvirtual-mapping-table nil
|
||
nnvirtual-mapping-offsets nil
|
||
nnvirtual-mapping-len 0
|
||
nnvirtual-mapping-reads nil
|
||
nnvirtual-mapping-marks nil
|
||
nnvirtual-info-installed nil)
|
||
(when nnvirtual-component-regexp
|
||
;; Go through the newsrc alist and find all component groups.
|
||
(let ((newsrc (cdr gnus-newsrc-alist))
|
||
group)
|
||
(while (setq group (car (pop newsrc)))
|
||
(when (string-match nnvirtual-component-regexp group) ; Match
|
||
;; Add this group to the list of component groups.
|
||
(setq nnvirtual-component-groups
|
||
(cons group (delete group nnvirtual-component-groups)))))))
|
||
(if (not nnvirtual-component-groups)
|
||
(nnheader-report 'nnvirtual "No component groups: %s" server)
|
||
t)))
|
||
|
||
|
||
(deffoo nnvirtual-request-group (group &optional server dont-check)
|
||
(nnvirtual-possibly-change-server server)
|
||
(setq nnvirtual-component-groups
|
||
(delete (nnvirtual-current-group) nnvirtual-component-groups))
|
||
(cond
|
||
((null nnvirtual-component-groups)
|
||
(setq nnvirtual-current-group nil)
|
||
(nnheader-report 'nnvirtual "No component groups in %s" group))
|
||
(t
|
||
(when (or (not dont-check)
|
||
nnvirtual-always-rescan)
|
||
(nnvirtual-create-mapping))
|
||
(setq nnvirtual-current-group group)
|
||
(nnheader-insert "211 %d 1 %d %s\n"
|
||
nnvirtual-mapping-len nnvirtual-mapping-len group))))
|
||
|
||
|
||
(deffoo nnvirtual-request-type (group &optional article)
|
||
(if (not article)
|
||
'unknown
|
||
(let ((mart (nnvirtual-map-article article)))
|
||
(when mart
|
||
(gnus-request-type (car mart) (cdr mart))))))
|
||
|
||
(deffoo nnvirtual-request-update-mark (group article mark)
|
||
(let* ((nart (nnvirtual-map-article article))
|
||
(cgroup (car nart))
|
||
;; The component group might be a virtual group.
|
||
(nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
|
||
(when (and nart
|
||
(= mark nmark)
|
||
(gnus-group-auto-expirable-p cgroup))
|
||
(setq mark gnus-expirable-mark)))
|
||
mark)
|
||
|
||
|
||
(deffoo nnvirtual-close-group (group &optional server)
|
||
(when (and (nnvirtual-possibly-change-server server)
|
||
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
|
||
(nnvirtual-update-read-and-marked t t))
|
||
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."))
|
||
|
||
|
||
(deffoo nnvirtual-request-list-newsgroups (&optional server)
|
||
(nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
|
||
|
||
|
||
(deffoo nnvirtual-request-update-info (group info &optional server)
|
||
(when (and (nnvirtual-possibly-change-server server)
|
||
(not nnvirtual-info-installed))
|
||
;; Install the precomputed lists atomically, so the virtual group
|
||
;; is not left in a half-way state in case of C-g.
|
||
(gnus-atomic-progn
|
||
(setcar (cddr info) nnvirtual-mapping-reads)
|
||
(if (nthcdr 3 info)
|
||
(setcar (nthcdr 3 info) nnvirtual-mapping-marks)
|
||
(when nnvirtual-mapping-marks
|
||
(setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
|
||
(setq nnvirtual-info-installed t))
|
||
t))
|
||
|
||
|
||
(deffoo nnvirtual-catchup-group (group &optional server all)
|
||
(when (and (nnvirtual-possibly-change-server server)
|
||
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
|
||
;; copy over existing marks first, in case they set anything
|
||
(nnvirtual-update-read-and-marked nil nil)
|
||
;; do a catchup on all component groups
|
||
(let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
|
||
(gnus-expert-user t))
|
||
;; Make sure all groups are activated.
|
||
(mapcar
|
||
(lambda (g)
|
||
(when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
|
||
(gnus-activate-group g)))
|
||
nnvirtual-component-groups)
|
||
(save-excursion
|
||
(set-buffer gnus-group-buffer)
|
||
(gnus-group-catchup-current nil all)))))
|
||
|
||
|
||
(deffoo nnvirtual-find-group-art (group article)
|
||
"Return the real group and article for virtual GROUP and ARTICLE."
|
||
(nnvirtual-map-article article))
|
||
|
||
|
||
;;; Internal functions.
|
||
|
||
(defun nnvirtual-convert-headers ()
|
||
"Convert HEAD headers into NOV headers."
|
||
(save-excursion
|
||
(set-buffer nntp-server-buffer)
|
||
(let* ((dependencies (make-vector 100 0))
|
||
(headers (gnus-get-newsgroup-headers dependencies))
|
||
header)
|
||
(erase-buffer)
|
||
(while (setq header (pop headers))
|
||
(nnheader-insert-nov header)))))
|
||
|
||
|
||
(defun nnvirtual-update-xref-header (group article prefix system-name)
|
||
"Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
|
||
;; Move to beginning of Xref field, creating a slot if needed.
|
||
(beginning-of-line)
|
||
(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)
|
||
(insert "\t"))
|
||
|
||
;; Remove any spaces at the beginning of the Xref field.
|
||
(while (= (char-after (1- (point))) ? )
|
||
(forward-char -1)
|
||
(delete-char 1))
|
||
|
||
(insert "Xref: " system-name " " group ":")
|
||
(princ article (current-buffer))
|
||
(insert " ")
|
||
|
||
;; If there were existing xref lines, clean them up to have the correct
|
||
;; component server prefix.
|
||
(save-restriction
|
||
(narrow-to-region (point)
|
||
(or (search-forward "\t" (gnus-point-at-eol) t)
|
||
(gnus-point-at-eol)))
|
||
(goto-char (point-min))
|
||
(when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
|
||
(replace-match "" t t))
|
||
(goto-char (point-min))
|
||
(when (re-search-forward
|
||
(concat (gnus-group-real-name group) ":[0-9]+")
|
||
nil t)
|
||
(replace-match "" t t))
|
||
(unless (= (point) (point-max))
|
||
(insert " ")
|
||
(when (not (string= "" prefix))
|
||
(while (re-search-forward "[^ ]+:[0-9]+" nil t)
|
||
(save-excursion
|
||
(goto-char (match-beginning 0))
|
||
(insert prefix))))))
|
||
|
||
;; Ensure a trailing \t.
|
||
(end-of-line)
|
||
(or (= (char-after (1- (point))) ?\t)
|
||
(insert ?\t)))
|
||
|
||
|
||
(defun nnvirtual-possibly-change-server (server)
|
||
(or (not server)
|
||
(nnoo-current-server-p 'nnvirtual server)
|
||
(nnvirtual-open-server server)))
|
||
|
||
|
||
(defun nnvirtual-update-read-and-marked (read-p update-p)
|
||
"Copy marks from the virtual group to the component groups.
|
||
If READ-P is not nil, update the (un)read status of the components.
|
||
If UPDATE-P is not nil, call gnus-group-update-group on the components."
|
||
(when nnvirtual-current-group
|
||
(let ((unreads (and read-p
|
||
(nnvirtual-partition-sequence
|
||
(gnus-list-of-unread-articles
|
||
(nnvirtual-current-group)))))
|
||
(type-marks (mapcar (lambda (ml)
|
||
(cons (car ml)
|
||
(nnvirtual-partition-sequence (cdr ml))))
|
||
(gnus-info-marks (gnus-get-info
|
||
(nnvirtual-current-group)))))
|
||
mark type groups carticles info entry)
|
||
|
||
;; Ok, atomically move all of the (un)read info, clear any old
|
||
;; marks, and move all of the current marks. This way if someone
|
||
;; hits C-g, you won't leave the component groups in a half-way state.
|
||
(gnus-atomic-progn
|
||
;; move (un)read
|
||
(let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles
|
||
(while (setq entry (pop 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)))
|
||
(gnus-info-marks info))
|
||
(gnus-info-set-marks info nil)))
|
||
|
||
;; 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))
|
||
(setq type (car mark))
|
||
(setq groups (cdr mark))
|
||
(while (setq carticles (pop 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))))))
|
||
|
||
|
||
(defun nnvirtual-current-group ()
|
||
"Return the prefixed name of the current nnvirtual group."
|
||
(concat "nnvirtual:" nnvirtual-current-group))
|
||
|
||
|
||
|
||
;;; This is currently O(kn^2) to merge n lists of length k.
|
||
;;; You could do it in O(knlogn), but we have a small n, and the
|
||
;;; overhead of the other approach is probably greater.
|
||
(defun nnvirtual-merge-sorted-lists (&rest lists)
|
||
"Merge many sorted lists of numbers."
|
||
(if (null (cdr lists))
|
||
(car lists)
|
||
(sort (apply 'nconc lists) '<)))
|
||
|
||
|
||
;;; 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:
|
||
;;;
|
||
;;; 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
|
||
|
||
;;; To compute these mappings we generate a couple tables and then
|
||
;;; do some fast operations on them. Tables for the example above:
|
||
;;;
|
||
;;; Offsets - [(A 0) (B -3) (C -1)]
|
||
;;;
|
||
;;; a b c d e
|
||
;;; Mapping - ([ 3 0 1 3 0 ]
|
||
;;; [ 6 3 2 9 3 ]
|
||
;;; [ 8 6 3 15 9 ])
|
||
;;;
|
||
;;; (note column 'e' is different in real algorithm, which is slightly
|
||
;;; different than described here, but this gives you the methodology.)
|
||
;;;
|
||
;;; The basic idea is this, when going from component->virtual, apply
|
||
;;; the appropriate offset to the article number. Then search the first
|
||
;;; column of the table for a row where 'a' is less than or equal to the
|
||
;;; modified number. You can see that only group A can therefore go to
|
||
;;; the first row, groups A and B to the second, and all to the last.
|
||
;;; The third column of the table is telling us the number of groups
|
||
;;; which might be able to reach that row (it might increase by more than
|
||
;;; 1 if several groups have the same size).
|
||
;;; Then column 'b' provides an additional offset you apply when you have
|
||
;;; found the correct row. You then multiply by 'c' and add on the groups
|
||
;;; _position_ in the offset table. The basic idea here is that on
|
||
;;; any given row we are going to map back and forth using X'=X*c+Y and
|
||
;;; X=(X'/c), Y=(X' mod c). Then once you've done this transformation,
|
||
;;; you apply a final offset from column 'e' to give the virtual article.
|
||
;;;
|
||
;;; Going the other direction, you instead search on column 'd' instead
|
||
;;; of 'a', and apply everything in reverse order.
|
||
|
||
;;; Convert component -> virtual:
|
||
;;; set num = num - Offset(group)
|
||
;;; find first row in Mapping where num <= 'a'
|
||
;;; num = (num-'b')*c + Position(group) + 'e'
|
||
|
||
;;; Convert virtual -> component:
|
||
;;; find first row in Mapping where num <= 'd'
|
||
;;; num = num - 'e'
|
||
;;; group_pos = num mod 'c'
|
||
;;; num = (num / 'c') + 'b' + Offset(group_pos)
|
||
|
||
;;; Easy no? :)
|
||
;;;
|
||
;;; Well actually, you need to keep column e offset smaller by the 'c'
|
||
;;; column for that line, and always add 1 more when going from
|
||
;;; component -> virtual. Otherwise you run into a problem with
|
||
;;; unique reverse mapping.
|
||
|
||
(defun nnvirtual-map-article (article)
|
||
"Return a cons of the component group and article corresponding to the given virtual ARTICLE."
|
||
(let ((table nnvirtual-mapping-table)
|
||
entry group-pos)
|
||
(while (and table
|
||
(> article (aref (car table) 3)))
|
||
(setq table (cdr table)))
|
||
(when (and table
|
||
(> article 0))
|
||
(setq entry (car table))
|
||
(setq article (- article (aref entry 4) 1))
|
||
(setq group-pos (mod article (aref entry 2)))
|
||
(cons (car (aref nnvirtual-mapping-offsets group-pos))
|
||
(+ (/ article (aref entry 2))
|
||
(aref entry 1)
|
||
(cdr (aref nnvirtual-mapping-offsets group-pos)))
|
||
))
|
||
))
|
||
|
||
|
||
|
||
(defun nnvirtual-reverse-map-article (group article)
|
||
"Return the virtual article number corresponding to the given component GROUP and ARTICLE."
|
||
(let ((table nnvirtual-mapping-table)
|
||
(group-pos 0)
|
||
entry)
|
||
(while (not (string= group (car (aref nnvirtual-mapping-offsets
|
||
group-pos))))
|
||
(setq group-pos (1+ group-pos)))
|
||
(setq article (- article (cdr (aref nnvirtual-mapping-offsets
|
||
group-pos))))
|
||
(while (and table
|
||
(> article (aref (car table) 0)))
|
||
(setq table (cdr table)))
|
||
(setq entry (car table))
|
||
(when (and entry
|
||
(> article 0)
|
||
(< group-pos (aref entry 2))) ; article not out of range below
|
||
(+ (aref entry 4)
|
||
group-pos
|
||
(* (- article (aref entry 1))
|
||
(aref entry 2))
|
||
1))
|
||
))
|
||
|
||
|
||
(defsubst nnvirtual-reverse-map-sequence (group articles)
|
||
"Return list of virtual article numbers for all ARTICLES in GROUP.
|
||
The ARTICLES should be sorted, and can be a compressed sequence.
|
||
If any of the article numbers has no corresponding virtual article,
|
||
then it is left out of the result."
|
||
(when (numberp (cdr-safe articles))
|
||
(setq articles (list articles)))
|
||
(let (result a i j new-a)
|
||
(while (setq a (pop articles))
|
||
(if (atom a)
|
||
(setq i a
|
||
j a)
|
||
(setq i (car a)
|
||
j (cdr a)))
|
||
(while (<= i j)
|
||
;; If this is slow, you can optimize by moving article checking
|
||
;; into here. You don't have to recompute the group-pos,
|
||
;; nor scan the table every time.
|
||
(when (setq new-a (nnvirtual-reverse-map-article group i))
|
||
(push new-a result))
|
||
(setq i (1+ i))))
|
||
(nreverse result)))
|
||
|
||
|
||
(defun nnvirtual-partition-sequence (articles)
|
||
"Return an association list of component article numbers.
|
||
These are indexed by elements of nnvirtual-component-groups, based on
|
||
the sequence ARTICLES of virtual article numbers. ARTICLES should be
|
||
sorted, and can be a compressed sequence. If any of the article
|
||
numbers has no corresponding component article, then it is left out of
|
||
the result."
|
||
(when (numberp (cdr-safe articles))
|
||
(setq articles (list articles)))
|
||
(let ((carticles (mapcar (lambda (g) (list g))
|
||
nnvirtual-component-groups))
|
||
a i j article entry)
|
||
(while (setq a (pop articles))
|
||
(if (atom a)
|
||
(setq i a
|
||
j a)
|
||
(setq i (car a)
|
||
j (cdr a)))
|
||
(while (<= i j)
|
||
(when (setq article (nnvirtual-map-article i))
|
||
(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)
|
||
carticles))
|
||
|
||
|
||
(defun nnvirtual-create-mapping ()
|
||
"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."
|
||
(let ((cnt 0)
|
||
(tot 0)
|
||
(M 0)
|
||
(i 0)
|
||
actives all-unreads all-marks
|
||
active min max size unreads marks
|
||
next-M next-tot
|
||
reads beg)
|
||
;; Ok, we loop over all component groups and collect a lot of
|
||
;; information:
|
||
;; Into actives we place (g size max), where size is max-min+1.
|
||
;; 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).
|
||
(mapc (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)
|
||
|
||
;; Number of articles in the virtual group.
|
||
(setq nnvirtual-mapping-len tot)
|
||
|
||
|
||
;; We want the actives list sorted by size, to build the tables.
|
||
(setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
|
||
|
||
;; Build the offset table. Largest sized groups are at the front.
|
||
(setq nnvirtual-mapping-offsets
|
||
(vconcat
|
||
(nreverse
|
||
(mapcar (lambda (entry)
|
||
(cons (nth 0 entry)
|
||
(- (nth 2 entry) M)))
|
||
actives))))
|
||
|
||
;; Build the mapping table.
|
||
(setq nnvirtual-mapping-table nil)
|
||
(setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
|
||
(while actives
|
||
(setq size (car actives))
|
||
(setq next-M (- M size))
|
||
(setq next-tot (- tot (* cnt size)))
|
||
;; make current row in table
|
||
(push (vector M next-M cnt tot (- next-tot cnt))
|
||
nnvirtual-mapping-table)
|
||
;; update M and tot
|
||
(setq M next-M)
|
||
(setq tot next-tot)
|
||
;; subtract the current size from all entries.
|
||
(setq actives (mapcar (lambda (x) (- x size)) actives))
|
||
;; remove anything that went to 0.
|
||
(while (and actives
|
||
(= (car actives) 0))
|
||
(pop actives)
|
||
(setq cnt (- cnt 1))))
|
||
|
||
|
||
;; Now that the mapping tables are generated, we can convert
|
||
;; and combine the separate component unreads and marks lists
|
||
;; into single lists of virtual article numbers.
|
||
(setq unreads (apply 'nnvirtual-merge-sorted-lists
|
||
(mapcar (lambda (x)
|
||
(nnvirtual-reverse-map-sequence
|
||
(car x) (cdr x)))
|
||
all-unreads)))
|
||
(setq marks (mapcar
|
||
(lambda (type)
|
||
(cons (cdr type)
|
||
(gnus-compress-sequence
|
||
(apply
|
||
'nnvirtual-merge-sorted-lists
|
||
(mapcar (lambda (x)
|
||
(nnvirtual-reverse-map-sequence
|
||
(car x)
|
||
(cdr (assq (cdr type) (cdr x)))))
|
||
all-marks)))))
|
||
gnus-article-mark-lists))
|
||
|
||
;; 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)))
|
||
|
||
;; We need to convert the unreads to reads. We compress the
|
||
;; sequence as we go, otherwise it could be huge.
|
||
(while (and (<= (incf i) nnvirtual-mapping-len)
|
||
unreads)
|
||
(if (= i (car unreads))
|
||
(setq unreads (cdr unreads))
|
||
;; try to get a range.
|
||
(setq beg i)
|
||
(while (and (<= (incf i) nnvirtual-mapping-len)
|
||
(not (= i (car unreads)))))
|
||
(setq i (- i 1))
|
||
(if (= i beg)
|
||
(push i reads)
|
||
(push (cons beg i) reads))
|
||
))
|
||
(when (<= i nnvirtual-mapping-len)
|
||
(if (= i nnvirtual-mapping-len)
|
||
(push i reads)
|
||
(push (cons i nnvirtual-mapping-len) reads)))
|
||
|
||
;; Store the reads list for later use.
|
||
(setq nnvirtual-mapping-reads (nreverse reads))
|
||
|
||
;; Throw flag to show we changed the info.
|
||
(setq nnvirtual-info-installed nil)
|
||
))
|
||
|
||
(provide 'nnvirtual)
|
||
|
||
;;; nnvirtual.el ends here
|