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