X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnnvirtual.el;h=48293412b2b56813af7233b5fca336d85940e007;hb=a45dd507bf71d9e3fbfb6067896554323b02b643;hp=1157eeba6ba2c672b581821788e82bdcbe4e8683;hpb=73c6f05af6afc303948a77bc5c94412a480e2164;p=elisp%2Fgnus.git- diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index 1157eeb..4829341 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,10 +1,9 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 -;; Free Software Foundation, Inc. +;; Copyright (C) 1994,95,96,97,98 Free Software Foundation, Inc. ;; Author: David Moore ;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. @@ -40,18 +39,19 @@ (require 'gnus-start) (require 'gnus-sum) (require 'gnus-msg) -(eval-when-compile (require 'cl)) +(require 'cl) (nnoo-declare nnvirtual) (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.") + "*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-component-regexp nil - "Regexp to match component groups.") + "*Regexp to match component groups.") (defvoo nnvirtual-component-groups nil "Component group in this nnvirtual group.") @@ -63,7 +63,8 @@ component group will show up when you enter the 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.") @@ -121,47 +122,47 @@ component group will show up when you enter the virtual group.") (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 @@ -198,9 +199,8 @@ component group will show up when you enter the virtual group.") (save-excursion (when buffer (set-buffer buffer)) - (let* ((gnus-override-method nil) - (method (gnus-find-method-for-group - nnvirtual-last-accessed-component-group))) + (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. @@ -219,9 +219,7 @@ component group will show up when you enter the virtual group.") (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-this-buffer (cdr amap) cgroup)) (gnus-request-article (cdr amap) cgroup)))))))) @@ -285,11 +283,11 @@ component group will show up when you enter the virtual group.") (deffoo nnvirtual-request-update-mark (group article mark) (let* ((nart (nnvirtual-map-article article)) - (cgroup (car nart))) + (cgroup (car nart)) + ;; 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) - ;; The component group might be a virtual group. - (= mark (gnus-request-update-mark cgroup (cdr nart) mark)) + (= mark nmark) (gnus-group-auto-expirable-p cgroup)) (setq mark gnus-expirable-mark))) mark) @@ -361,23 +359,6 @@ component group will show up when you enter the virtual group.") (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) '<))) - ;;; Internal functions. @@ -404,7 +385,7 @@ component group will show up when you enter the virtual group.") (insert "\t")) ;; Remove any spaces at the beginning of the Xref field. - (while (eq (char-after (1- (point))) ? ) + (while (= (char-after (1- (point))) ? ) (forward-char -1) (delete-char 1)) @@ -436,7 +417,7 @@ component group will show up when you enter the virtual group.") ;; Ensure a trailing \t. (end-of-line) - (or (eq (char-after (1- (point))) ?\t) + (or (= (char-after (1- (point))) ?\t) (insert ?\t))) @@ -455,24 +436,19 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (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)))))) + (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 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 + (gnus-atomic-progn ;; move (un)read - ;; bind for workaround guns-update-read-articles - (let ((gnus-newsgroup-active nil)) + (let ((gnus-newsgroup-active nil)) ;workaround guns-update-read-articles (while (setq entry (pop unreads)) (gnus-update-read-articles (car entry) (cdr entry)))) @@ -481,11 +457,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (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)))) + (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 @@ -521,15 +493,14 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." ;;; 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 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: +;;; 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: ;;; ;;; 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 @@ -600,7 +571,7 @@ If UPDATE-P is not nil, call gnus-group-update-group on the components." (aref entry 1) (cdr (aref nnvirtual-mapping-offsets group-pos))) )) - )) + )) @@ -658,7 +629,7 @@ 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 +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)) @@ -700,28 +671,28 @@ 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). - (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) + (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) ;; Number of articles in the virtual group. (setq nnvirtual-mapping-len tot)