X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnnvirtual.el;h=810dbe5adef878d5b26b0d313122505c3c546afe;hb=6dec94a79261794ce4ce843a2780d23a4effa334;hp=58754266c9d7dc8d2142ae5ada9d7c57b9b56afa;hpb=7c13cb18da8d917ec6688dd63face28caf457158;p=gnus diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 58754266c..810dbe5ad 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,8 +1,8 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994,95,96 Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98,99 Free Software Foundation, Inc. ;; Author: David Moore -;; Lars Magne Ingebrigtsen +;; Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news @@ -38,16 +38,16 @@ (require 'gnus-util) (require 'gnus-start) (require 'gnus-sum) +(require 'gnus-msg) (eval-when-compile (require 'cl)) (nnoo-declare nnvirtual) -(defvoo nnvirtual-always-rescan nil +(defvoo nnvirtual-always-rescan t "*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.") +If this variable is nil and you read articles in a component group +after the virtual group has been activated, the read articles from the +component group will show up when you enter the virtual group.") (defvoo nnvirtual-component-regexp nil "*Regexp to match component groups.") @@ -62,23 +62,22 @@ virtual group.") (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.") + "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.") + "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.") + "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.") + "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 "") @@ -100,7 +99,7 @@ marks of individual component groups.") (erase-buffer) (if (stringp (car articles)) 'headers - (let ((vbuf (nnheader-set-temp-buffer + (let ((vbuf (nnheader-set-temp-buffer (get-buffer-create " *virtual headers*"))) (carticles (nnvirtual-partition-sequence articles)) (system-name (system-name)) @@ -121,47 +120,47 @@ marks of individual component groups.") (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)) + (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 @@ -184,26 +183,44 @@ marks of individual component groups.") (kill-buffer vbuf))))))) +(defvoo nnvirtual-last-accessed-component-group nil) (deffoo nnvirtual-request-article (article &optional group server buffer) - (when (and (nnvirtual-possibly-change-server server) - (numberp article)) - (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 - (if buffer - (save-excursion - (set-buffer buffer) - (gnus-request-article-this-buffer (cdr amap) cgroup)) - (gnus-request-article (cdr amap) cgroup))))))) + (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) + ;; We bind this here to avoid double decoding. + (let ((gnus-article-decode-hook nil)) + (gnus-request-article-this-buffer (cdr amap) cgroup))) + (gnus-request-article (cdr amap) cgroup)))))))) (deffoo nnvirtual-open-server (server &optional defs) @@ -217,7 +234,8 @@ marks of individual component groups.") nnvirtual-mapping-offsets nil nnvirtual-mapping-len 0 nnvirtual-mapping-reads nil - nnvirtual-mapping-marks 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)) @@ -241,20 +259,27 @@ marks of individual component groups.") (setq nnvirtual-current-group nil) (nnheader-report 'nnvirtual "No component groups in %s" group)) (t + (setq nnvirtual-current-group group) (when (or (not dont-check) nnvirtual-always-rescan) - (nnvirtual-create-mapping)) - (setq nnvirtual-current-group group) - (nnheader-insert "211 %d 1 %d %s\n" + (nnvirtual-create-mapping) + (when nnvirtual-always-rescan + (nnvirtual-request-update-info + (nnvirtual-current-group) + (gnus-get-info (nnvirtual-current-group))))) + (nnheader-insert "211 %d 1 %d %s\n" nnvirtual-mapping-len nnvirtual-mapping-len group)))) (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)))))) + (if (numberp article) + (let ((mart (nnvirtual-map-article article))) + (if mart + (gnus-request-type (car mart) (cdr mart)))) + (gnus-request-type + nnvirtual-last-accessed-component-group nil)))) (deffoo nnvirtual-request-update-mark (group article mark) (let* ((nart (nnvirtual-map-article article)) @@ -262,20 +287,19 @@ marks of individual component groups.") ;; The component group might be a virtual group. (nmark (gnus-request-update-mark cgroup (cdr nart) mark))) (when (and nart + (memq mark gnus-auto-expirable-marks) (= 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)))) - ;; Copy (un)read status and marks back to component groups. - (nnvirtual-update-reads) - (nnvirtual-update-marked t)) + (nnvirtual-update-read-and-marked t t)) t) - + (deffoo nnvirtual-request-list (&optional server) (nnheader-report 'nnvirtual "LIST is not implemented.")) @@ -290,21 +314,25 @@ marks of individual component groups.") (deffoo nnvirtual-request-update-info (group info &optional server) - (when (nnvirtual-possibly-change-server server) - ;; Install the lists. - (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)))) + (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-marked nil) + (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)) @@ -323,6 +351,24 @@ marks of individual component groups.") "Return the real group and article for virtual GROUP and ARTICLE." (nnvirtual-map-article article)) + +(deffoo nnvirtual-request-post (&optional server) + (if (not gnus-message-group-art) + (nnheader-report 'nnvirtual "Can't post to an nnvirtual group") + (let ((group (car (nnvirtual-find-group-art + (car gnus-message-group-art) + (cdr gnus-message-group-art))))) + (gnus-request-post (gnus-find-method-for-group group))))) + + +(deffoo nnvirtual-request-expire-articles (articles group + &optional server force) + (nnvirtual-possibly-change-server server) + (setq nnvirtual-component-groups + (delete (nnvirtual-current-group) nnvirtual-component-groups)) + (dolist (group nnvirtual-component-groups) + (gnus-group-expire-articles-1 group))) + ;;; Internal functions. @@ -339,8 +385,7 @@ marks of individual component groups.") (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." + "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 @@ -350,32 +395,39 @@ component group, and also server prefix any existing xref lines." (insert "\t")) ;; Remove any spaces at the beginning of the Xref field. - (while (= (char-after (1- (point))) ? ) + (while (eq (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. - (let ((xref-end (save-excursion - (search-forward "\t" (gnus-point-at-eol) 'move) - (point))) - (len (length prefix))) - (unless (= (point) xref-end) + (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 (regexp-quote (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]+" xref-end t) + (while (re-search-forward "[^ ]+:[0-9]+" nil t) (save-excursion (goto-char (match-beginning 0)) - (insert prefix)) - (setq xref-end (+ xref-end len))) - ))) + (insert prefix)))))) ;; Ensure a trailing \t. (end-of-line) - (or (= (char-after (1- (point))) ?\t) + (or (eq (char-after (1- (point))) ?\t) (insert ?\t))) @@ -385,49 +437,62 @@ component group, and also server prefix any existing xref lines." (nnvirtual-open-server server))) -(defun nnvirtual-update-reads () - "Copy (un)read status from the virtual group to the component groups." - (let ((unreads (nnvirtual-partition-sequence (gnus-list-of-unread-articles - (nnvirtual-current-group)))) - entry) - (while (setq entry (pop unreads)) - (gnus-update-read-articles (car entry) (cdr entry))))) - - -(defun nnvirtual-update-marked (update-p) +(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." - (let ((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) - - ;; clear all existing marks on the component groups, since - ;; we install new versions below. - (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))) - )) + (when nnvirtual-current-group + (let ((unreads (and read-p + (nnvirtual-partition-sequence + (gnus-list-of-unread-articles + (nnvirtual-current-group))))) + (type-marks + (delq nil + (mapcar (lambda (ml) + (if (eq (car ml) 'score) + nil + (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. + (progn + ;; move (un)read + ;; bind for workaround guns-update-read-articles + (let ((gnus-newsgroup-active nil)) + (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 + (if (assq 'score (gnus-info-marks info)) + (list (assq 'score (gnus-info-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 () @@ -443,10 +508,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." "Merge many sorted lists of numbers." (if (null (cdr lists)) (car lists) - (apply 'nnvirtual-merge-sorted-lists - (merge 'list (car lists) (cadr lists) '<) - (cddr lists)))) - + (sort (apply 'nconc lists) '<))) ;;; We map between virtual articles and real articles in a manner @@ -512,8 +574,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;;; unique reverse mapping. (defun nnvirtual-map-article (article) - "Return a cons of the component group and article corresponding to -the given virtual 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 @@ -529,37 +590,37 @@ the given virtual ARTICLE." (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 + "Return the virtual article number corresponding to the given component GROUP and ARTICLE." + (when (numberp 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)))) - (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)) - )) - - -(defun nnvirtual-reverse-map-sequence (group articles) + (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, @@ -584,11 +645,12 @@ then it is left out of the result." (defun nnvirtual-partition-sequence (articles) - "Return an association list of component article numbers, 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." + "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)) @@ -605,15 +667,15 @@ no corresponding component article, then it is left out of the result." (setq entry (assoc (car article) carticles)) (setcdr entry (cons (cdr article) (cdr entry)))) (setq i (1+ i)))) - (mapc '(lambda (x) (setcdr x (nreverse (cdr x)))) - carticles) + (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." + "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) @@ -628,28 +690,28 @@ the virtual group based on the marks on the component groups." ;; Into all-unreads we put (g unreads). ;; Into all-marks we put (g marks). ;; We also increment cnt and tot here, and compute M (max of sizes). - (mapc (lambda (g) - (setq active (gnus-activate-group g) - min (car active) - max (cdr active)) - (when (and active (>= max min)) - ;; 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) + (mapcar (lambda (g) + (setq active (gnus-activate-group g) + min (car active) + max (cdr active)) + (when (and active (>= max min) (not (zerop max))) + ;; store active information + (push (list g (- max min -1) max) actives) + ;; collect unread/mark info for later + (setq unreads (gnus-list-of-unread-articles g)) + (setq marks (gnus-info-marks (gnus-get-info g))) + (when gnus-use-cache + (push (cons 'cache + (gnus-cache-articles-in-group g)) + marks)) + (push (cons g unreads) all-unreads) + (push (cons g marks) all-marks) + ;; count groups, total #articles, and max size + (setq size (- max min -1)) + (setq cnt (1+ cnt) + tot (+ tot size) + M (max M size)))) + nnvirtual-component-groups) ;; Number of articles in the virtual group. (setq nnvirtual-mapping-len tot) @@ -657,7 +719,7 @@ the virtual group based on the marks on the component groups." ;; 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 @@ -666,7 +728,7 @@ the virtual group based on the marks on the component groups." (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)) @@ -711,7 +773,11 @@ the virtual group based on the marks on the component groups." gnus-article-mark-lists)) ;; Remove any empty marks lists, and store. - (setq nnvirtual-mapping-marks (delete-if-not 'cdr marks)) + (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. @@ -735,6 +801,9 @@ the virtual group based on the marks on the component groups." ;; 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)