;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994,95,96,97 Free Software Foundation, Inc.
+;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
;; Author: David Moore <dmoore@ucsd.edu>
-;; Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
+;; Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news
;; This file is part of GNU Emacs.
(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
- "*If non-nil, always scan groups for unread articles when entering a group.
-If this variable is nil (which is the default) and you read articles
-in a component group after the virtual group has been activated, the
-read articles from the component group will show up when you enter the
-virtual group.")
+(defvoo nnvirtual-always-rescan t
+ "If non-nil, always scan groups for unread articles when entering a 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.")
+ "Regexp to match component groups.")
(defvoo nnvirtual-component-groups nil
"Component group in this nnvirtual 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.")
(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))
(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
'nnvirtual "Don't know what server to request from"))
(t
(save-excursion
- (when buffer
+ (when buffer
(set-buffer buffer))
- (let ((method (gnus-find-method-for-group
- nnvirtual-last-accessed-component-group)))
+ (let* ((gnus-override-method nil)
+ (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.
(nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
(t
(setq nnvirtual-last-accessed-component-group cgroup)
- (if buffer
+ (if buffer
(save-excursion
(set-buffer buffer)
- (gnus-request-article-this-buffer (cdr amap) cgroup))
+ ;; 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))))))))
(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))
- (cgroup (car nart))
- ;; The component group might be a virtual group.
- (nmark (gnus-request-update-mark cgroup (cdr nart) mark)))
+ (cgroup (car nart)))
(when (and nart
- (= mark nmark)
+ (memq mark gnus-auto-expirable-marks)
+ ;; The component group might be a virtual group.
+ (= mark (gnus-request-update-mark cgroup (cdr nart) mark))
(gnus-group-auto-expirable-p cgroup))
(setq mark gnus-expirable-mark)))
mark)
-
+
(deffoo nnvirtual-close-group (group &optional server)
(when (and (nnvirtual-possibly-change-server server)
(not (gnus-ephemeral-group-p (nnvirtual-current-group))))
(nnvirtual-update-read-and-marked t t))
t)
-
+
(deffoo nnvirtual-request-list (&optional server)
(nnheader-report 'nnvirtual "LIST is not implemented."))
(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)
;; Make sure all groups are activated.
(mapcar
(lambda (g)
- (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
+ (when (not (numberp (gnus-group-unread g)))
(gnus-activate-group g)))
nnvirtual-component-groups)
(save-excursion
"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))
+ (let (unexpired)
+ (dolist (group nnvirtual-component-groups)
+ (setq unexpired (nconc unexpired
+ (mapcar
+ #'(lambda (article)
+ (nnvirtual-reverse-map-article
+ group article))
+ (gnus-uncompress-range
+ (gnus-group-expire-articles-1 group))))))
+ (sort (delq nil unexpired) '<)))
+
\f
;;; Internal functions.
(looking-at
"[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
(goto-char (match-end 0))
- (unless (search-forward "\t" (gnus-point-at-eol) 'move)
+ (unless (search-forward "\t" (point-at-eol) 'move)
(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" (point-at-eol) t)
+ (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 (eobp)
(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)))
If UPDATE-P is not nil, call gnus-group-update-group on the components."
(when nnvirtual-current-group
(let ((unreads (and read-p
- (nnvirtual-partition-sequence
- (gnus-list-of-unread-articles
+ (nnvirtual-partition-sequence
+ (gnus-list-of-unread-articles
(nnvirtual-current-group)))))
- (type-marks (mapcar (lambda (ml)
- (cons (car ml)
- (nnvirtual-partition-sequence (cdr ml))))
- (gnus-info-marks (gnus-get-info
- (nnvirtual-current-group)))))
+ (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.
- (gnus-atomic-progn
+ (progn
;; move (un)read
- (let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles
+ ;; 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))))
(while groups
(when (and (setq info (gnus-get-info (pop groups)))
(gnus-info-marks info))
- (gnus-info-set-marks info nil)))
-
+ (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.
(setq type (car mark))
(setq groups (cdr mark))
(while (setq carticles (pop groups))
- (gnus-add-marked-articles (car carticles) type (cdr carticles)
+ (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)
"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
-;;; which keeps the size of the virtual active list the same as
-;;; the sum of the component active lists.
-;;; To achieve fair mixing of the groups, the last article in
-;;; each of N component groups will be in the the last N articles
-;;; in the virtual group.
-
-;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and 6-7
-;;; resprectively, then the virtual article numbers look like:
+;;; which keeps the size of the virtual active list the same as the
+;;; sum of the component active lists.
+
+;;; To achieve fair mixing of the groups, the last article in each of
+;;; N component groups will be in the last N articles in the virtual
+;;; group.
+
+;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and
+;;; 6-7 respectively, then the virtual article numbers look like:
;;;
;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
(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
+ (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,
"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
+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 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.
+ "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)
;; Into all-unreads we put (g unreads).
;; Into all-marks we put (g marks).
;; We also increment cnt and tot here, and compute M (max of sizes).
- (mapc (lambda (g)
- (setq active (gnus-activate-group g)
- min (car active)
- max (cdr active))
- (when (and active (>= max min) (not (zerop max)))
- ;; store active information
- (push (list g (- max min -1) max) actives)
- ;; collect unread/mark info for later
- (setq unreads (gnus-list-of-unread-articles g))
- (setq marks (gnus-info-marks (gnus-get-info g)))
- (when gnus-use-cache
- (push (cons 'cache
- (gnus-cache-articles-in-group g))
- marks))
- (push (cons g unreads) all-unreads)
- (push (cons g marks) all-marks)
- ;; count groups, total #articles, and max size
- (setq size (- max min -1))
- (setq cnt (1+ cnt)
- tot (+ tot size)
- M (max M size))))
- nnvirtual-component-groups)
+ (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)
;; 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
(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))
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.
projects / gnus / blobdiff