cgit.sxemacs.org Git - gnus/blob - lisp/nnvirtual.el

   1 ;;; nnvirtual.el --- virtual newsgroups access for Gnus
   2 ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
   3
   4 ;; Author: David Moore <dmoore@ucsd.edu>
   5 ;;      Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
   6 ;;      Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
   7 ;; Keywords: news
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; The other access methods (nntp, nnspool, etc) are general news
  29 ;; access methods.  This module relies on Gnus and can not be used
  30 ;; separately.
  31
  32 ;;; Code:
  33
  34 (require 'nntp)
  35 (require 'nnheader)
  36 (require 'gnus)
  37 (require 'nnoo)
  38 (require 'gnus-util)
  39 (require 'gnus-start)
  40 (require 'gnus-sum)
  41 (eval-when-compile (require 'cl))
  42
  43 (nnoo-declare nnvirtual)
  44
  45 (defvoo nnvirtual-always-rescan nil
  46   "*If non-nil, always scan groups for unread articles when entering a group.
  47 If this variable is nil (which is the default) and you read articles
  48 in a component group after the virtual group has been activated, the
  49 read articles from the component group will show up when you enter the
  50 virtual group.")
  51
  52 (defvoo nnvirtual-component-regexp nil
  53   "*Regexp to match component groups.")
  54
  55 (defvoo nnvirtual-component-groups nil
  56   "Component group in this nnvirtual group.")
  57
  58 \f
  59
  60 (defconst nnvirtual-version "nnvirtual 1.1")
  61
  62 (defvoo nnvirtual-current-group nil)
  63
  64 (defvoo nnvirtual-mapping-table nil
  65   "Table of rules on how to map between component group and article number
  66 to virtual article number.")
  67
  68 (defvoo nnvirtual-mapping-offsets nil
  69   "Table indexed by component group to an offset to be applied to article numbers in that group.")
  70
  71 (defvoo nnvirtual-mapping-len 0
  72   "Number of articles in this virtual group.")
  73
  74 (defvoo nnvirtual-mapping-reads nil
  75   "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
  76
  77 (defvoo nnvirtual-mapping-marks nil
  78   "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
  79
  80 (defvoo nnvirtual-status-string "")
  81
  82 (eval-and-compile
  83   (autoload 'gnus-cache-articles-in-group "gnus-cache"))
  84
  85 \f
  86
  87 ;;; Interface functions.
  88
  89 (nnoo-define-basics nnvirtual)
  90
  91
  92 (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
  93                                              server fetch-old)
  94   (when (nnvirtual-possibly-change-server server)
  95     (save-excursion
  96       (set-buffer nntp-server-buffer)
  97       (erase-buffer)
  98       (if (stringp (car articles))
  99           'headers
 100         (let ((vbuf (nnheader-set-temp-buffer
 101                      (get-buffer-create " *virtual headers*")))
 102               (carticles (nnvirtual-partition-sequence articles))
 103               (system-name (system-name))
 104               cgroup carticle article result prefix)
 105           (while carticles
 106             (setq cgroup (caar carticles))
 107             (setq articles (cdar carticles))
 108             (pop carticles)
 109             (when (and articles
 110                        (gnus-check-server
 111                         (gnus-find-method-for-group cgroup) t)
 112                        (gnus-request-group cgroup t)
 113                        (setq prefix (gnus-group-real-prefix cgroup))
 114                        ;; FIX FIX FIX we want to check the cache!
 115                        ;; This is probably evil if people have set
 116                        ;; gnus-use-cache to nil themselves, but I
 117                        ;; have no way of finding the true value of it.
 118                        (let ((gnus-use-cache t))
 119                          (setq result (gnus-retrieve-headers
 120                                        articles cgroup nil))))
 121             (set-buffer nntp-server-buffer)
 122             ;; If we got HEAD headers, we convert them into NOV
 123             ;; headers.  This is slow, inefficient and, come to think
 124             ;; of it, downright evil.  So sue me.  I couldn't be
 125             ;; bothered to write a header parse routine that could
 126             ;; parse a mixed HEAD/NOV buffer.
 127             (when (eq result 'headers)
 128               (nnvirtual-convert-headers))
 129             (goto-char (point-min))
 130             (while (not (eobp))
 131               (delete-region (point)
 132                              (progn
 133                                (setq carticle (read nntp-server-buffer))
 134                                (point)))
 135
 136               ;; We remove this article from the articles list, if
 137               ;; anything is left in the articles list after going through
 138               ;; the entire buffer, then those articles have been
 139               ;; expired or canceled, so we appropriately update the
 140               ;; component group below.  They should be coming up
 141               ;; generally in order, so this shouldn't be slow.
 142               (setq articles (delq carticle articles))
 143
 144               (setq article (nnvirtual-reverse-map-article cgroup carticle))
 145               (if (null article)
 146                   ;; This line has no reverse mapping, that means it
 147                   ;; was an extra article reference returned by nntp.
 148                   (progn
 149                     (beginning-of-line)
 150                     (delete-region (point) (progn (forward-line 1) (point))))
 151                 ;; Otherwise insert the virtual article number,
 152                 ;; and clean up the xrefs.
 153                 (princ article nntp-server-buffer)
 154                 (nnvirtual-update-xref-header cgroup carticle
 155                                               prefix system-name)
 156                 (forward-line 1))
 157               )
 158
 159             (set-buffer vbuf)
 160             (goto-char (point-max))
 161             (insert-buffer-substring nntp-server-buffer))
 162             ;; Anything left in articles is expired or canceled.
 163             ;; Could be smart and not tell it about articles already known?
 164             (when articles
 165               (gnus-group-make-articles-read cgroup articles))
 166             )
 167
 168           ;; The headers are ready for reading, so they are inserted into
 169           ;; the nntp-server-buffer, which is where Gnus expects to find
 170           ;; them.
 171           (prog1
 172               (save-excursion
 173                 (set-buffer nntp-server-buffer)
 174                 (erase-buffer)
 175                 (insert-buffer-substring vbuf)
 176                 ;; FIX FIX FIX, we should be able to sort faster than
 177                 ;; this if needed, since each cgroup is sorted, we just
 178                 ;; need to merge
 179                 (sort-numeric-fields 1 (point-min) (point-max))
 180                 'nov)
 181             (kill-buffer vbuf)))))))
 182
 183
 184
 185 (deffoo nnvirtual-request-article (article &optional group server buffer)
 186   (when (and (nnvirtual-possibly-change-server server)
 187              (numberp article))
 188     (let* ((amap (nnvirtual-map-article article))
 189            (cgroup (car amap)))
 190       (cond
 191        ((not amap)
 192         (nnheader-report 'nnvirtual "No such article: %s" article))
 193        ((not (gnus-check-group cgroup))
 194         (nnheader-report
 195          'nnvirtual "Can't open server where %s exists" cgroup))
 196        ((not (gnus-request-group cgroup t))
 197         (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
 198        (t
 199         (if buffer
 200             (save-excursion
 201               (set-buffer buffer)
 202               (gnus-request-article-this-buffer (cdr amap) cgroup))
 203           (gnus-request-article (cdr amap) cgroup)))))))
 204
 205
 206 (deffoo nnvirtual-open-server (server &optional defs)
 207   (unless (assq 'nnvirtual-component-regexp defs)
 208     (push `(nnvirtual-component-regexp ,server)
 209           defs))
 210   (nnoo-change-server 'nnvirtual server defs)
 211   (if nnvirtual-component-groups
 212       t
 213     (setq nnvirtual-mapping-table nil
 214           nnvirtual-mapping-offsets nil
 215           nnvirtual-mapping-len 0
 216           nnvirtual-mapping-reads nil
 217           nnvirtual-mapping-marks nil)
 218     (when nnvirtual-component-regexp
 219       ;; Go through the newsrc alist and find all component groups.
 220       (let ((newsrc (cdr gnus-newsrc-alist))
 221             group)
 222         (while (setq group (car (pop newsrc)))
 223           (when (string-match nnvirtual-component-regexp group) ; Match
 224             ;; Add this group to the list of component groups.
 225             (setq nnvirtual-component-groups
 226                   (cons group (delete group nnvirtual-component-groups)))))))
 227     (if (not nnvirtual-component-groups)
 228         (nnheader-report 'nnvirtual "No component groups: %s" server)
 229       t)))
 230
 231
 232 (deffoo nnvirtual-request-group (group &optional server dont-check)
 233   (nnvirtual-possibly-change-server server)
 234   (setq nnvirtual-component-groups
 235         (delete (nnvirtual-current-group) nnvirtual-component-groups))
 236   (cond
 237    ((null nnvirtual-component-groups)
 238     (setq nnvirtual-current-group nil)
 239     (nnheader-report 'nnvirtual "No component groups in %s" group))
 240    (t
 241     (when (or (not dont-check)
 242               nnvirtual-always-rescan)
 243       (nnvirtual-create-mapping))
 244     (setq nnvirtual-current-group group)
 245     (nnheader-insert "211 %d 1 %d %s\n"
 246                      nnvirtual-mapping-len nnvirtual-mapping-len group))))
 247
 248
 249 (deffoo nnvirtual-request-type (group &optional article)
 250   (if (not article)
 251       'unknown
 252     (let ((mart (nnvirtual-map-article article)))
 253       (when mart
 254         (gnus-request-type (car mart) (cdr mart))))))
 255
 256 (deffoo nnvirtual-request-update-mark (group article mark)
 257   (let* ((nart (nnvirtual-map-article article))
 258          (cgroup (car nart))
 259          ;; The component group might be a virtual group.
 260          (nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
 261     (when (and nart
 262                (= mark nmark)
 263                (gnus-group-auto-expirable-p cgroup))
 264       (setq mark gnus-expirable-mark)))
 265   mark)
 266
 267
 268 (deffoo nnvirtual-close-group (group &optional server)
 269   (when (and (nnvirtual-possibly-change-server server)
 270              (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
 271     ;; Copy (un)read status and marks back to component groups.
 272     (nnvirtual-update-reads)
 273     (nnvirtual-update-marked t))
 274   t)
 275
 276
 277 (deffoo nnvirtual-request-list (&optional server)
 278   (nnheader-report 'nnvirtual "LIST is not implemented."))
 279
 280
 281 (deffoo nnvirtual-request-newgroups (date &optional server)
 282   (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
 283
 284
 285 (deffoo nnvirtual-request-list-newsgroups (&optional server)
 286   (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
 287
 288
 289 (deffoo nnvirtual-request-update-info (group info &optional server)
 290   (when (nnvirtual-possibly-change-server server)
 291     ;; Install the lists.
 292     (setcar (cddr info) nnvirtual-mapping-reads)
 293     (if (nthcdr 3 info)
 294         (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
 295       (when nnvirtual-mapping-marks
 296         (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
 297     t))
 298
 299
 300 (deffoo nnvirtual-catchup-group (group &optional server all)
 301   (when (and (nnvirtual-possibly-change-server server)
 302              (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
 303     ;; copy over existing marks first, in case they set anything
 304     (nnvirtual-update-marked nil)
 305     ;; do a catchup on all component groups
 306     (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
 307           (gnus-expert-user t))
 308       ;; Make sure all groups are activated.
 309       (mapcar
 310        (lambda (g)
 311          (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
 312            (gnus-activate-group g)))
 313        nnvirtual-component-groups)
 314       (save-excursion
 315         (set-buffer gnus-group-buffer)
 316         (gnus-group-catchup-current nil all)))))
 317
 318
 319 (deffoo nnvirtual-find-group-art (group article)
 320   "Return the real group and article for virtual GROUP and ARTICLE."
 321   (nnvirtual-map-article article))
 322
 323 \f
 324 ;;; Internal functions.
 325
 326 (defun nnvirtual-convert-headers ()
 327   "Convert HEAD headers into NOV headers."
 328   (save-excursion
 329     (set-buffer nntp-server-buffer)
 330     (let* ((dependencies (make-vector 100 0))
 331            (headers (gnus-get-newsgroup-headers dependencies))
 332            header)
 333       (erase-buffer)
 334       (while (setq header (pop headers))
 335         (nnheader-insert-nov header)))))
 336
 337
 338 (defun nnvirtual-update-xref-header (group article prefix system-name)
 339   "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
 340   ;; Move to beginning of Xref field, creating a slot if needed.
 341   (beginning-of-line)
 342   (looking-at
 343    "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
 344   (goto-char (match-end 0))
 345   (unless (search-forward "\t" (gnus-point-at-eol) 'move)
 346     (insert "\t"))
 347
 348   ;; Remove any spaces at the beginning of the Xref field.
 349   (while (= (char-after (1- (point))) ? )
 350     (forward-char -1)
 351     (delete-char 1))
 352
 353   (insert "Xref: " system-name " " group ":")
 354   (princ article (current-buffer))
 355
 356   ;; If there were existing xref lines, clean them up to have the correct
 357   ;; component server prefix.
 358   (let ((xref-end (save-excursion
 359                     (search-forward "\t" (gnus-point-at-eol) 'move)
 360                     (point)))
 361         (len (length prefix)))
 362     (unless (= (point) xref-end)
 363       (insert " ")
 364       (when (not (string= "" prefix))
 365         (while (re-search-forward "[^ ]+:[0-9]+" xref-end t)
 366           (save-excursion
 367             (goto-char (match-beginning 0))
 368             (insert prefix))
 369           (setq xref-end (+ xref-end len)))
 370         )))
 371
 372   ;; Ensure a trailing \t.
 373   (end-of-line)
 374   (or (= (char-after (1- (point))) ?\t)
 375       (insert ?\t)))
 376
 377
 378 (defun nnvirtual-possibly-change-server (server)
 379   (or (not server)
 380       (nnoo-current-server-p 'nnvirtual server)
 381       (nnvirtual-open-server server)))
 382
 383
 384 (defun nnvirtual-update-reads ()
 385   "Copy (un)read status from the virtual group to the component groups."
 386   (let ((unreads (nnvirtual-partition-sequence (gnus-list-of-unread-articles
 387                                                 (nnvirtual-current-group))))
 388         entry)
 389     (while (setq entry (pop unreads))
 390       (gnus-update-read-articles (car entry) (cdr entry)))))
 391
 392
 393 (defun nnvirtual-update-marked (update-p)
 394   "Copy marks from the virtual group to the component groups.
 395 If UPDATE-P is not nil, call gnus-group-update-group on the components."
 396   (let ((type-marks (mapcar (lambda (ml)
 397                               (cons (car ml)
 398                                     (nnvirtual-partition-sequence (cdr ml))))
 399                             (gnus-info-marks (gnus-get-info
 400                                               (nnvirtual-current-group)))))
 401         mark type groups carticles info)
 402
 403     ;; clear all existing marks on the component groups, since
 404     ;; we install new versions below.
 405     (setq groups nnvirtual-component-groups)
 406     (while groups
 407       (when (and (setq info (gnus-get-info (pop groups)))
 408                  (gnus-info-marks info))
 409         (gnus-info-set-marks info nil)))
 410
 411     ;; Ok, currently type-marks is an assq list with keys of a mark type,
 412     ;; with data of an assq list with keys of component group names
 413     ;; and the articles which correspond to that key/group pair.
 414     (while (setq mark (pop type-marks))
 415       (setq type (car mark))
 416       (setq groups (cdr mark))
 417       (while (setq carticles (pop groups))
 418         (gnus-add-marked-articles (car carticles) type (cdr carticles)
 419                                   nil t)))
 420
 421     ;; possibly update the display, it is really slow
 422     (when update-p
 423       (setq groups nnvirtual-component-groups)
 424       (while groups
 425         (gnus-group-update-group (pop groups) t)))
 426     ))
 427
 428
 429 (defun nnvirtual-current-group ()
 430   "Return the prefixed name of the current nnvirtual group."
 431   (concat "nnvirtual:" nnvirtual-current-group))
 432
 433
 434
 435 ;;; This is currently O(kn^2) to merge n lists of length k.
 436 ;;; You could do it in O(knlogn), but we have a small n, and the
 437 ;;; overhead of the other approach is probably greater.
 438 (defun nnvirtual-merge-sorted-lists (&rest lists)
 439   "Merge many sorted lists of numbers."
 440   (if (null (cdr lists))
 441       (car lists)
 442     (apply 'nnvirtual-merge-sorted-lists
 443            (merge 'list (car lists) (cadr lists) '<)
 444            (cddr lists))))
 445
 446
 447
 448 ;;; We map between virtual articles and real articles in a manner
 449 ;;; which keeps the size of the virtual active list the same as
 450 ;;; the sum of the component active lists.
 451 ;;; To achieve fair mixing of the groups, the last article in
 452 ;;; each of N component groups will be in the the last N articles
 453 ;;; in the virtual group.
 454
 455 ;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
 456 ;;; resprectively, then the virtual article numbers look like:
 457 ;;;
 458 ;;;  1  2  3  4  5  6  7  8  9  10 11 12 13 14 15
 459 ;;;  A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
 460
 461 ;;; To compute these mappings we generate a couple tables and then
 462 ;;; do some fast operations on them.  Tables for the example above:
 463 ;;;
 464 ;;; Offsets - [(A 0) (B -3) (C -1)]
 465 ;;;
 466 ;;;               a  b  c  d  e
 467 ;;; Mapping - ([  3  0  1  3  0 ]
 468 ;;;            [  6  3  2  9  3 ]
 469 ;;;            [  8  6  3 15  9 ])
 470 ;;;
 471 ;;; (note column 'e' is different in real algorithm, which is slightly
 472 ;;;  different than described here, but this gives you the methodology.)
 473 ;;;
 474 ;;; The basic idea is this, when going from component->virtual, apply
 475 ;;; the appropriate offset to the article number.  Then search the first
 476 ;;; column of the table for a row where 'a' is less than or equal to the
 477 ;;; modified number.  You can see that only group A can therefore go to
 478 ;;; the first row, groups A and B to the second, and all to the last.
 479 ;;; The third column of the table is telling us the number of groups
 480 ;;; which might be able to reach that row (it might increase by more than
 481 ;;; 1 if several groups have the same size).
 482 ;;; Then column 'b' provides an additional offset you apply when you have
 483 ;;; found the correct row.  You then multiply by 'c' and add on the groups
 484 ;;; _position_ in the offset table.  The basic idea here is that on
 485 ;;; any given row we are going to map back and forth using X'=X*c+Y and
 486 ;;; X=(X'/c), Y=(X' mod c).  Then once you've done this transformation,
 487 ;;; you apply a final offset from column 'e' to give the virtual article.
 488 ;;;
 489 ;;; Going the other direction, you instead search on column 'd' instead
 490 ;;; of 'a', and apply everything in reverse order.
 491
 492 ;;; Convert component -> virtual:
 493 ;;; set num = num - Offset(group)
 494 ;;; find first row in Mapping where num <= 'a'
 495 ;;; num = (num-'b')*c + Position(group) + 'e'
 496
 497 ;;; Convert virtual -> component:
 498 ;;; find first row in Mapping where num <= 'd'
 499 ;;; num = num - 'e'
 500 ;;; group_pos = num mod 'c'
 501 ;;; num = (num / 'c') + 'b' + Offset(group_pos)
 502
 503 ;;; Easy no? :)
 504 ;;;
 505 ;;; Well actually, you need to keep column e offset smaller by the 'c'
 506 ;;; column for that line, and always add 1 more when going from
 507 ;;; component -> virtual.  Otherwise you run into a problem with
 508 ;;; unique reverse mapping.
 509
 510 (defun nnvirtual-map-article (article)
 511   "Return a cons of the component group and article corresponding to the given virtual ARTICLE."
 512   (let ((table nnvirtual-mapping-table)
 513         entry group-pos)
 514     (while (and table
 515                 (> article (aref (car table) 3)))
 516       (setq table (cdr table)))
 517     (when (and table
 518                (> article 0))
 519       (setq entry (car table))
 520       (setq article (- article (aref entry 4) 1))
 521       (setq group-pos (mod article (aref entry 2)))
 522       (cons (car (aref nnvirtual-mapping-offsets group-pos))
 523             (+ (/ article (aref entry 2))
 524                (aref entry 1)
 525                (cdr (aref nnvirtual-mapping-offsets group-pos)))
 526             ))
 527       ))
 528
 529
 530
 531 (defun nnvirtual-reverse-map-article (group article)
 532   "Return the virtual article number corresponding to the given component GROUP and ARTICLE."
 533   (let ((table nnvirtual-mapping-table)
 534         (group-pos 0)
 535         entry)
 536     (while (not (string= group (car (aref nnvirtual-mapping-offsets
 537                                           group-pos))))
 538       (setq group-pos (1+ group-pos)))
 539     (setq article (- article (cdr (aref nnvirtual-mapping-offsets
 540                                         group-pos))))
 541     (while (and table
 542                 (> article (aref (car table) 0)))
 543       (setq table (cdr table)))
 544     (setq entry (car table))
 545     (when (and entry
 546                (> article 0)
 547                (< group-pos (aref entry 2))) ; article not out of range below
 548       (+ (aref entry 4)
 549          group-pos
 550          (* (- article (aref entry 1))
 551             (aref entry 2))
 552          1))
 553     ))
 554
 555
 556 (defun nnvirtual-reverse-map-sequence (group articles)
 557   "Return list of virtual article numbers for all ARTICLES in GROUP.
 558 The ARTICLES should be sorted, and can be a compressed sequence.
 559 If any of the article numbers has no corresponding virtual article,
 560 then it is left out of the result."
 561   (when (numberp (cdr-safe articles))
 562     (setq articles (list articles)))
 563   (let (result a i j new-a)
 564     (while (setq a (pop articles))
 565       (if (atom a)
 566           (setq i a
 567                 j a)
 568         (setq i (car a)
 569               j (cdr a)))
 570       (while (<= i j)
 571         ;; If this is slow, you can optimize by moving article checking
 572         ;; into here.  You don't have to recompute the group-pos,
 573         ;; nor scan the table every time.
 574         (when (setq new-a (nnvirtual-reverse-map-article group i))
 575           (push new-a result))
 576         (setq i (1+ i))))
 577     (nreverse result)))
 578
 579
 580 (defun nnvirtual-partition-sequence (articles)
 581   "Return an association list of component article numbers.
 582 These are indexed by elements of nnvirtual-component-groups, based on
 583 the sequence ARTICLES of virtual article numbers.  ARTICLES should be
 584 sorted, and can be a compressed sequence. If any of the article
 585 numbers has no corresponding component article, then it is left out of
 586 the result."
 587   (when (numberp (cdr-safe articles))
 588     (setq articles (list articles)))
 589   (let ((carticles (mapcar (lambda (g) (list g))
 590                            nnvirtual-component-groups))
 591         a i j article entry)
 592     (while (setq a (pop articles))
 593       (if (atom a)
 594           (setq i a
 595                 j a)
 596         (setq i (car a)
 597               j (cdr a)))
 598       (while (<= i j)
 599         (when (setq article (nnvirtual-map-article i))
 600           (setq entry (assoc (car article) carticles))
 601           (setcdr entry (cons (cdr article) (cdr entry))))
 602         (setq i (1+ i))))
 603     (mapc '(lambda (x) (setcdr x (nreverse (cdr x))))
 604           carticles)
 605     carticles))
 606
 607
 608 (defun nnvirtual-create-mapping ()
 609   "Build the tables necessary to map between component (group, article) to virtual article.
 610 Generate the set of read messages and marks for the virtual group
 611 based on the marks on the component groups."
 612   (let ((cnt 0)
 613         (tot 0)
 614         (M 0)
 615         (i 0)
 616         actives all-unreads all-marks
 617         active min max size unreads marks
 618         next-M next-tot
 619         reads beg)
 620     ;; Ok, we loop over all component groups and collect a lot of
 621     ;; information:
 622     ;; Into actives we place (g size max), where size is max-min+1.
 623     ;; Into all-unreads we put (g unreads).
 624     ;; Into all-marks we put (g marks).
 625     ;; We also increment cnt and tot here, and compute M (max of sizes).
 626     (mapc (lambda (g)
 627             (setq active (gnus-activate-group g)
 628                   min (car active)
 629                   max (cdr active))
 630             (when (and active (>= max min) (not (zerop max)))
 631               ;; store active information
 632               (push (list g (- max min -1) max) actives)
 633               ;; collect unread/mark info for later
 634               (setq unreads (gnus-list-of-unread-articles g))
 635               (setq marks (gnus-info-marks (gnus-get-info g)))
 636               (when gnus-use-cache
 637                 (push (cons 'cache
 638                             (gnus-cache-articles-in-group g))
 639                       marks))
 640               (push (cons g unreads) all-unreads)
 641               (push (cons g marks) all-marks)
 642               ;; count groups, total #articles, and max size
 643               (setq size (- max min -1))
 644               (setq cnt (1+ cnt)
 645                     tot (+ tot size)
 646                     M (max M size))))
 647           nnvirtual-component-groups)
 648
 649     ;; Number of articles in the virtual group.
 650     (setq nnvirtual-mapping-len tot)
 651
 652
 653     ;; We want the actives list sorted by size, to build the tables.
 654     (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
 655
 656     ;; Build the offset table.  Largest sized groups are at the front.
 657     (setq nnvirtual-mapping-offsets
 658           (vconcat
 659            (nreverse
 660             (mapcar (lambda (entry)
 661                       (cons (nth 0 entry)
 662                             (- (nth 2 entry) M)))
 663                     actives))))
 664
 665     ;; Build the mapping table.
 666     (setq nnvirtual-mapping-table nil)
 667     (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
 668     (while actives
 669       (setq size (car actives))
 670       (setq next-M (- M size))
 671       (setq next-tot (- tot (* cnt size)))
 672       ;; make current row in table
 673       (push (vector M next-M cnt tot (- next-tot cnt))
 674             nnvirtual-mapping-table)
 675       ;; update M and tot
 676       (setq M next-M)
 677       (setq tot next-tot)
 678       ;; subtract the current size from all entries.
 679       (setq actives (mapcar (lambda (x) (- x size)) actives))
 680       ;; remove anything that went to 0.
 681       (while (and actives
 682                   (= (car actives) 0))
 683         (pop actives)
 684         (setq cnt (- cnt 1))))
 685
 686
 687     ;; Now that the mapping tables are generated, we can convert
 688     ;; and combine the separate component unreads and marks lists
 689     ;; into single lists of virtual article numbers.
 690     (setq unreads (apply 'nnvirtual-merge-sorted-lists
 691                          (mapcar (lambda (x)
 692                                    (nnvirtual-reverse-map-sequence
 693                                     (car x) (cdr x)))
 694                                  all-unreads)))
 695     (setq marks (mapcar
 696                  (lambda (type)
 697                    (cons (cdr type)
 698                          (gnus-compress-sequence
 699                           (apply
 700                            'nnvirtual-merge-sorted-lists
 701                            (mapcar (lambda (x)
 702                                      (nnvirtual-reverse-map-sequence
 703                                       (car x)
 704                                       (cdr (assq (cdr type) (cdr x)))))
 705                                    all-marks)))))
 706                  gnus-article-mark-lists))
 707
 708     ;; Remove any empty marks lists, and store.
 709     (setq nnvirtual-mapping-marks (delete-if-not 'cdr marks))
 710
 711     ;; We need to convert the unreads to reads.  We compress the
 712     ;; sequence as we go, otherwise it could be huge.
 713     (while (and (<= (incf i) nnvirtual-mapping-len)
 714                 unreads)
 715       (if (= i (car unreads))
 716           (setq unreads (cdr unreads))
 717         ;; try to get a range.
 718         (setq beg i)
 719         (while (and (<= (incf i) nnvirtual-mapping-len)
 720                     (not (= i (car unreads)))))
 721         (setq i (- i 1))
 722         (if (= i beg)
 723             (push i reads)
 724           (push (cons beg i) reads))
 725         ))
 726     (when (<= i nnvirtual-mapping-len)
 727       (if (= i nnvirtual-mapping-len)
 728           (push i reads)
 729         (push (cons i nnvirtual-mapping-len) reads)))
 730
 731     ;; Store the reads list for later use.
 732     (setq nnvirtual-mapping-reads (nreverse reads))
 733     ))
 734
 735 (provide 'nnvirtual)
 736
 737 ;;; nnvirtual.el ends here