1 ;;; nnvirtual.el --- virtual newsgroups access for Gnus
2 ;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
4 ;; Author: David Moore <dmoore@ucsd.edu>
5 ;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
6 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
9 ;; This file is part of GNU Emacs.
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)
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.
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.
28 ;; The other access methods (nntp, nnspool, etc) are general news
29 ;; access methods. This module relies on Gnus and can not be used
41 (eval-when-compile (require 'cl))
43 (nnoo-declare nnvirtual)
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
52 (defvoo nnvirtual-component-regexp nil
53 "*Regexp to match component groups.")
55 (defvoo nnvirtual-component-groups nil
56 "Component group in this nnvirtual group.")
60 (defconst nnvirtual-version "nnvirtual 1.1")
62 (defvoo nnvirtual-current-group nil)
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.")
68 (defvoo nnvirtual-mapping-offsets nil
69 "Table indexed by component group to an offset to be applied to article
70 numbers in that group.")
72 (defvoo nnvirtual-mapping-len 0
73 "Number of articles in this virtual group.")
75 (defvoo nnvirtual-mapping-reads nil
76 "Compressed sequence of read articles on the virtual group as computed
77 from the unread status of individual component groups.")
79 (defvoo nnvirtual-mapping-marks nil
80 "Compressed marks alist for the virtual group as computed from the
81 marks of individual component groups.")
83 (defvoo nnvirtual-status-string "")
86 (autoload 'gnus-cache-articles-in-group "gnus-cache"))
90 ;;; Interface functions.
92 (nnoo-define-basics nnvirtual)
95 (deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
97 (when (nnvirtual-possibly-change-server server)
99 (set-buffer nntp-server-buffer)
101 (if (stringp (car articles))
103 (let ((vbuf (nnheader-set-temp-buffer
104 (get-buffer-create " *virtual headers*")))
105 (carticles (nnvirtual-partition-sequence articles))
106 (system-name (system-name))
107 cgroup carticle article result prefix)
109 (setq cgroup (caar carticles))
110 (setq articles (cdar carticles))
114 (gnus-find-method-for-group cgroup) t)
115 (gnus-request-group cgroup t)
116 (setq prefix (gnus-group-real-prefix cgroup))
117 ;; FIX FIX FIX we want to check the cache!
118 ;; This is probably evil if people have set
119 ;; gnus-use-cache to nil themselves, but I
120 ;; have no way of finding the true value of it.
121 (let ((gnus-use-cache t))
122 (setq result (gnus-retrieve-headers
123 articles cgroup nil))))
124 (set-buffer nntp-server-buffer)
125 ;; If we got HEAD headers, we convert them into NOV
126 ;; headers. This is slow, inefficient and, come to think
127 ;; of it, downright evil. So sue me. I couldn't be
128 ;; bothered to write a header parse routine that could
129 ;; parse a mixed HEAD/NOV buffer.
130 (when (eq result 'headers)
131 (nnvirtual-convert-headers))
132 (goto-char (point-min))
134 (delete-region (point)
136 (setq carticle (read nntp-server-buffer))
139 ;; We remove this article from the articles list, if
140 ;; anything is left in the articles list after going through
141 ;; the entire buffer, then those articles have been
142 ;; expired or canceled, so we appropriately update the
143 ;; component group below. They should be coming up
144 ;; generally in order, so this shouldn't be slow.
145 (setq articles (delq carticle articles))
147 (setq article (nnvirtual-reverse-map-article cgroup carticle))
149 ;; This line has no reverse mapping, that means it
150 ;; was an extra article reference returned by nntp.
153 (delete-region (point) (progn (forward-line 1) (point))))
154 ;; Otherwise insert the virtual article number,
155 ;; and clean up the xrefs.
156 (princ article nntp-server-buffer)
157 (nnvirtual-update-xref-header cgroup carticle
163 (goto-char (point-max))
164 (insert-buffer-substring nntp-server-buffer))
165 ;; Anything left in articles is expired or canceled.
166 ;; Could be smart and not tell it about articles already known?
168 (gnus-group-make-articles-read cgroup articles))
171 ;; The headers are ready for reading, so they are inserted into
172 ;; the nntp-server-buffer, which is where Gnus expects to find
176 (set-buffer nntp-server-buffer)
178 (insert-buffer-substring vbuf)
179 ;; FIX FIX FIX, we should be able to sort faster than
180 ;; this if needed, since each cgroup is sorted, we just
182 (sort-numeric-fields 1 (point-min) (point-max))
184 (kill-buffer vbuf)))))))
188 (deffoo nnvirtual-request-article (article &optional group server buffer)
189 (when (and (nnvirtual-possibly-change-server server)
191 (let* ((amap (nnvirtual-map-article article))
195 (nnheader-report 'nnvirtual "No such article: %s" article))
196 ((not (gnus-check-group cgroup))
198 'nnvirtual "Can't open server where %s exists" cgroup))
199 ((not (gnus-request-group cgroup t))
200 (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
205 (gnus-request-article-this-buffer (cdr amap) cgroup))
206 (gnus-request-article (cdr amap) cgroup)))))))
209 (deffoo nnvirtual-open-server (server &optional defs)
210 (unless (assq 'nnvirtual-component-regexp defs)
211 (push `(nnvirtual-component-regexp ,server)
213 (nnoo-change-server 'nnvirtual server defs)
214 (if nnvirtual-component-groups
216 (setq nnvirtual-mapping-table nil
217 nnvirtual-mapping-offsets nil
218 nnvirtual-mapping-len 0
219 nnvirtual-mapping-reads nil
220 nnvirtual-mapping-marks nil)
221 (when nnvirtual-component-regexp
222 ;; Go through the newsrc alist and find all component groups.
223 (let ((newsrc (cdr gnus-newsrc-alist))
225 (while (setq group (car (pop newsrc)))
226 (when (string-match nnvirtual-component-regexp group) ; Match
227 ;; Add this group to the list of component groups.
228 (setq nnvirtual-component-groups
229 (cons group (delete group nnvirtual-component-groups)))))))
230 (if (not nnvirtual-component-groups)
231 (nnheader-report 'nnvirtual "No component groups: %s" server)
235 (deffoo nnvirtual-request-group (group &optional server dont-check)
236 (nnvirtual-possibly-change-server server)
237 (setq nnvirtual-component-groups
238 (delete (nnvirtual-current-group) nnvirtual-component-groups))
240 ((null nnvirtual-component-groups)
241 (setq nnvirtual-current-group nil)
242 (nnheader-report 'nnvirtual "No component groups in %s" group))
244 (when (or (not dont-check)
245 nnvirtual-always-rescan)
246 (nnvirtual-create-mapping))
247 (setq nnvirtual-current-group group)
248 (nnheader-insert "211 %d 1 %d %s\n"
249 nnvirtual-mapping-len nnvirtual-mapping-len group))))
252 (deffoo nnvirtual-request-type (group &optional article)
255 (let ((mart (nnvirtual-map-article article)))
257 (gnus-request-type (car mart) (cdr mart))))))
259 (deffoo nnvirtual-request-update-mark (group article mark)
260 (let* ((nart (nnvirtual-map-article article))
262 ;; The component group might be a virtual group.
263 (nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
266 (gnus-group-auto-expirable-p cgroup))
267 (setq mark gnus-expirable-mark)))
271 (deffoo nnvirtual-close-group (group &optional server)
272 (when (and (nnvirtual-possibly-change-server server)
273 (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
274 ;; Copy (un)read status and marks back to component groups.
275 (nnvirtual-update-reads)
276 (nnvirtual-update-marked t))
280 (deffoo nnvirtual-request-list (&optional server)
281 (nnheader-report 'nnvirtual "LIST is not implemented."))
284 (deffoo nnvirtual-request-newgroups (date &optional server)
285 (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
288 (deffoo nnvirtual-request-list-newsgroups (&optional server)
289 (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
292 (deffoo nnvirtual-request-update-info (group info &optional server)
293 (when (nnvirtual-possibly-change-server server)
294 ;; Install the lists.
295 (setcar (cddr info) nnvirtual-mapping-reads)
297 (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
298 (when nnvirtual-mapping-marks
299 (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
303 (deffoo nnvirtual-catchup-group (group &optional server all)
304 (when (and (nnvirtual-possibly-change-server server)
305 (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
306 ;; copy over existing marks first, in case they set anything
307 (nnvirtual-update-marked nil)
308 ;; do a catchup on all component groups
309 (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
310 (gnus-expert-user t))
311 ;; Make sure all groups are activated.
314 (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
315 (gnus-activate-group g)))
316 nnvirtual-component-groups)
318 (set-buffer gnus-group-buffer)
319 (gnus-group-catchup-current nil all)))))
322 (deffoo nnvirtual-find-group-art (group article)
323 "Return the real group and article for virtual GROUP and ARTICLE."
324 (nnvirtual-map-article article))
327 ;;; Internal functions.
329 (defun nnvirtual-convert-headers ()
330 "Convert HEAD headers into NOV headers."
332 (set-buffer nntp-server-buffer)
333 (let* ((dependencies (make-vector 100 0))
334 (headers (gnus-get-newsgroup-headers dependencies))
337 (while (setq header (pop headers))
338 (nnheader-insert-nov header)))))
341 (defun nnvirtual-update-xref-header (group article prefix system-name)
342 "Edit current NOV header in current buffer to have an xref to the
343 component group, and also server prefix any existing xref lines."
344 ;; Move to beginning of Xref field, creating a slot if needed.
347 "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
348 (goto-char (match-end 0))
349 (unless (search-forward "\t" (gnus-point-at-eol) 'move)
352 ;; Remove any spaces at the beginning of the Xref field.
353 (while (= (char-after (1- (point))) ? )
357 (insert "Xref: " system-name " " group ":")
358 (princ article (current-buffer))
360 ;; If there were existing xref lines, clean them up to have the correct
361 ;; component server prefix.
362 (let ((xref-end (save-excursion
363 (search-forward "\t" (gnus-point-at-eol) 'move)
365 (len (length prefix)))
366 (unless (= (point) xref-end)
368 (when (not (string= "" prefix))
369 (while (re-search-forward "[^ ]+:[0-9]+" xref-end t)
371 (goto-char (match-beginning 0))
373 (setq xref-end (+ xref-end len)))
376 ;; Ensure a trailing \t.
378 (or (= (char-after (1- (point))) ?\t)
382 (defun nnvirtual-possibly-change-server (server)
384 (nnoo-current-server-p 'nnvirtual server)
385 (nnvirtual-open-server server)))
388 (defun nnvirtual-update-reads ()
389 "Copy (un)read status from the virtual group to the component groups."
390 (let ((unreads (nnvirtual-partition-sequence (gnus-list-of-unread-articles
391 (nnvirtual-current-group))))
393 (while (setq entry (pop unreads))
394 (gnus-update-read-articles (car entry) (cdr entry)))))
397 (defun nnvirtual-update-marked (update-p)
398 "Copy marks from the virtual group to the component groups.
399 If UPDATE-P is not nil, call gnus-group-update-group on the components."
400 (let ((type-marks (mapcar (lambda (ml)
402 (nnvirtual-partition-sequence (cdr ml))))
403 (gnus-info-marks (gnus-get-info
404 (nnvirtual-current-group)))))
405 mark type groups carticles info)
407 ;; clear all existing marks on the component groups, since
408 ;; we install new versions below.
409 (setq groups nnvirtual-component-groups)
411 (when (and (setq info (gnus-get-info (pop groups)))
412 (gnus-info-marks info))
413 (gnus-info-set-marks info nil)))
415 ;; Ok, currently type-marks is an assq list with keys of a mark type,
416 ;; with data of an assq list with keys of component group names
417 ;; and the articles which correspond to that key/group pair.
418 (while (setq mark (pop type-marks))
419 (setq type (car mark))
420 (setq groups (cdr mark))
421 (while (setq carticles (pop groups))
422 (gnus-add-marked-articles (car carticles) type (cdr carticles)
425 ;; possibly update the display, it is really slow
427 (setq groups nnvirtual-component-groups)
429 (gnus-group-update-group (pop groups) t)))
433 (defun nnvirtual-current-group ()
434 "Return the prefixed name of the current nnvirtual group."
435 (concat "nnvirtual:" nnvirtual-current-group))
439 ;;; This is currently O(kn^2) to merge n lists of length k.
440 ;;; You could do it in O(knlogn), but we have a small n, and the
441 ;;; overhead of the other approach is probably greater.
442 (defun nnvirtual-merge-sorted-lists (&rest lists)
443 "Merge many sorted lists of numbers."
444 (if (null (cdr lists))
446 (apply 'nnvirtual-merge-sorted-lists
447 (merge 'list (car lists) (cadr lists) '<)
452 ;;; We map between virtual articles and real articles in a manner
453 ;;; which keeps the size of the virtual active list the same as
454 ;;; the sum of the component active lists.
455 ;;; To achieve fair mixing of the groups, the last article in
456 ;;; each of N component groups will be in the the last N articles
457 ;;; in the virtual group.
459 ;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
460 ;;; resprectively, then the virtual article numbers look like:
462 ;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
463 ;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
465 ;;; To compute these mappings we generate a couple tables and then
466 ;;; do some fast operations on them. Tables for the example above:
468 ;;; Offsets - [(A 0) (B -3) (C -1)]
471 ;;; Mapping - ([ 3 0 1 3 0 ]
475 ;;; (note column 'e' is different in real algorithm, which is slightly
476 ;;; different than described here, but this gives you the methodology.)
478 ;;; The basic idea is this, when going from component->virtual, apply
479 ;;; the appropriate offset to the article number. Then search the first
480 ;;; column of the table for a row where 'a' is less than or equal to the
481 ;;; modified number. You can see that only group A can therefore go to
482 ;;; the first row, groups A and B to the second, and all to the last.
483 ;;; The third column of the table is telling us the number of groups
484 ;;; which might be able to reach that row (it might increase by more than
485 ;;; 1 if several groups have the same size).
486 ;;; Then column 'b' provides an additional offset you apply when you have
487 ;;; found the correct row. You then multiply by 'c' and add on the groups
488 ;;; _position_ in the offset table. The basic idea here is that on
489 ;;; any given row we are going to map back and forth using X'=X*c+Y and
490 ;;; X=(X'/c), Y=(X' mod c). Then once you've done this transformation,
491 ;;; you apply a final offset from column 'e' to give the virtual article.
493 ;;; Going the other direction, you instead search on column 'd' instead
494 ;;; of 'a', and apply everything in reverse order.
496 ;;; Convert component -> virtual:
497 ;;; set num = num - Offset(group)
498 ;;; find first row in Mapping where num <= 'a'
499 ;;; num = (num-'b')*c + Position(group) + 'e'
501 ;;; Convert virtual -> component:
502 ;;; find first row in Mapping where num <= 'd'
504 ;;; group_pos = num mod 'c'
505 ;;; num = (num / 'c') + 'b' + Offset(group_pos)
509 ;;; Well actually, you need to keep column e offset smaller by the 'c'
510 ;;; column for that line, and always add 1 more when going from
511 ;;; component -> virtual. Otherwise you run into a problem with
512 ;;; unique reverse mapping.
514 (defun nnvirtual-map-article (article)
515 "Return a cons of the component group and article corresponding to
516 the given virtual ARTICLE."
517 (let ((table nnvirtual-mapping-table)
520 (> article (aref (car table) 3)))
521 (setq table (cdr table)))
524 (setq entry (car table))
525 (setq article (- article (aref entry 4) 1))
526 (setq group-pos (mod article (aref entry 2)))
527 (cons (car (aref nnvirtual-mapping-offsets group-pos))
528 (+ (/ article (aref entry 2))
530 (cdr (aref nnvirtual-mapping-offsets group-pos)))
536 (defun nnvirtual-reverse-map-article (group article)
537 "Return the virtual article number corresponding to the given
538 component GROUP and ARTICLE."
539 (let ((table nnvirtual-mapping-table)
542 (while (not (string= group (car (aref nnvirtual-mapping-offsets
544 (setq group-pos (1+ group-pos)))
545 (setq article (- article (cdr (aref nnvirtual-mapping-offsets
548 (> article (aref (car table) 0)))
549 (setq table (cdr table)))
550 (setq entry (car table))
553 (< group-pos (aref entry 2))) ; article not out of range below
556 (* (- article (aref entry 1))
562 (defun nnvirtual-reverse-map-sequence (group articles)
563 "Return list of virtual article numbers for all ARTICLES in GROUP.
564 The ARTICLES should be sorted, and can be a compressed sequence.
565 If any of the article numbers has no corresponding virtual article,
566 then it is left out of the result."
567 (when (numberp (cdr-safe articles))
568 (setq articles (list articles)))
569 (let (result a i j new-a)
570 (while (setq a (pop articles))
577 ;; If this is slow, you can optimize by moving article checking
578 ;; into here. You don't have to recompute the group-pos,
579 ;; nor scan the table every time.
580 (when (setq new-a (nnvirtual-reverse-map-article group i))
586 (defun nnvirtual-partition-sequence (articles)
587 "Return an association list of component article numbers, indexed
588 by elements of nnvirtual-component-groups, based on the sequence
589 ARTICLES of virtual article numbers. ARTICLES should be sorted,
590 and can be a compressed sequence. If any of the article numbers has
591 no corresponding component article, then it is left out of the result."
592 (when (numberp (cdr-safe articles))
593 (setq articles (list articles)))
594 (let ((carticles (mapcar (lambda (g) (list g))
595 nnvirtual-component-groups))
597 (while (setq a (pop articles))
604 (when (setq article (nnvirtual-map-article i))
605 (setq entry (assoc (car article) carticles))
606 (setcdr entry (cons (cdr article) (cdr entry))))
608 (mapc '(lambda (x) (setcdr x (nreverse (cdr x))))
613 (defun nnvirtual-create-mapping ()
614 "Build the tables necessary to map between component (group, article)
615 to virtual article. Generate the set of read messages and marks for
616 the virtual group based on the marks on the component groups."
621 actives all-unreads all-marks
622 active min max size unreads marks
625 ;; Ok, we loop over all component groups and collect a lot of
627 ;; Into actives we place (g size max), where size is max-min+1.
628 ;; Into all-unreads we put (g unreads).
629 ;; Into all-marks we put (g marks).
630 ;; We also increment cnt and tot here, and compute M (max of sizes).
632 (setq active (gnus-activate-group g)
635 (when (and active (>= max min))
636 ;; store active information
637 (push (list g (- max min -1) max) actives)
638 ;; collect unread/mark info for later
639 (setq unreads (gnus-list-of-unread-articles g))
640 (setq marks (gnus-info-marks (gnus-get-info g)))
643 (gnus-cache-articles-in-group g))
645 (push (cons g unreads) all-unreads)
646 (push (cons g marks) all-marks)
647 ;; count groups, total #articles, and max size
648 (setq size (- max min -1))
652 nnvirtual-component-groups)
654 ;; Number of articles in the virtual group.
655 (setq nnvirtual-mapping-len tot)
658 ;; We want the actives list sorted by size, to build the tables.
659 (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
661 ;; Build the offset table. Largest sized groups are at the front.
662 (setq nnvirtual-mapping-offsets
665 (mapcar (lambda (entry)
667 (- (nth 2 entry) M)))
670 ;; Build the mapping table.
671 (setq nnvirtual-mapping-table nil)
672 (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
674 (setq size (car actives))
675 (setq next-M (- M size))
676 (setq next-tot (- tot (* cnt size)))
677 ;; make current row in table
678 (push (vector M next-M cnt tot (- next-tot cnt))
679 nnvirtual-mapping-table)
683 ;; subtract the current size from all entries.
684 (setq actives (mapcar (lambda (x) (- x size)) actives))
685 ;; remove anything that went to 0.
689 (setq cnt (- cnt 1))))
692 ;; Now that the mapping tables are generated, we can convert
693 ;; and combine the separate component unreads and marks lists
694 ;; into single lists of virtual article numbers.
695 (setq unreads (apply 'nnvirtual-merge-sorted-lists
697 (nnvirtual-reverse-map-sequence
703 (gnus-compress-sequence
705 'nnvirtual-merge-sorted-lists
707 (nnvirtual-reverse-map-sequence
709 (cdr (assq (cdr type) (cdr x)))))
711 gnus-article-mark-lists))
713 ;; Remove any empty marks lists, and store.
714 (setq nnvirtual-mapping-marks (delete-if-not 'cdr marks))
716 ;; We need to convert the unreads to reads. We compress the
717 ;; sequence as we go, otherwise it could be huge.
718 (while (and (<= (incf i) nnvirtual-mapping-len)
720 (if (= i (car unreads))
721 (setq unreads (cdr unreads))
722 ;; try to get a range.
724 (while (and (<= (incf i) nnvirtual-mapping-len)
725 (not (= i (car unreads)))))
729 (push (cons beg i) reads))
731 (when (<= i nnvirtual-mapping-len)
732 (if (= i nnvirtual-mapping-len)
734 (push (cons i nnvirtual-mapping-len) reads)))
736 ;; Store the reads list for later use.
737 (setq nnvirtual-mapping-reads (nreverse reads))
742 ;;; nnvirtual.el ends here