X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnnvirtual.el;h=0023248f7fd725441fa637af36e2965750540320;hp=d8bf70d725dee543e88832020b85acf1d968166a;hb=125d88b46ad2efa065f06d5dac37a245b488985a;hpb=807e3ebcecfdb28c8ea4876813070d13f174d20f diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el index d8bf70d72..0023248f7 100644 --- a/lisp/nnvirtual.el +++ b/lisp/nnvirtual.el @@ -1,9 +1,10 @@ ;;; nnvirtual.el --- virtual newsgroups access for Gnus -;; Copyright (C) 1994,95,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003 +;; Free Software Foundation, Inc. ;; Author: David Moore ;; Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Masanobu UMEDA ;; Keywords: news ;; This file is part of GNU Emacs. @@ -39,19 +40,18 @@ (require 'gnus-start) (require 'gnus-sum) (require 'gnus-msg) -(require 'cl) +(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.") @@ -63,8 +63,7 @@ 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.") @@ -122,47 +121,47 @@ to virtual article number.") (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 @@ -199,8 +198,9 @@ to virtual article number.") (save-excursion (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. @@ -219,7 +219,9 @@ to virtual article number.") (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)))))))) @@ -259,12 +261,14 @@ to virtual article number.") (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) (when nnvirtual-always-rescan - (nnvirtual-request-update-info group (gnus-get-info group)))) - (setq nnvirtual-current-group group) + (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)))) @@ -281,11 +285,11 @@ to virtual article number.") (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) @@ -334,9 +338,9 @@ to virtual article number.") (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups)) (gnus-expert-user t)) ;; Make sure all groups are activated. - (mapcar + (mapc (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 @@ -357,6 +361,23 @@ to virtual article number.") (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. @@ -379,11 +400,11 @@ to virtual article number.") (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)) @@ -395,8 +416,8 @@ to virtual article number.") ;; component server prefix. (save-restriction (narrow-to-region (point) - (or (search-forward "\t" (gnus-point-at-eol) t) - (gnus-point-at-eol))) + (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)) @@ -405,7 +426,7 @@ to virtual article number.") (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+") nil t) (replace-match "" t t)) - (unless (= (point) (point-max)) + (unless (eobp) (insert " ") (when (not (string= "" prefix)) (while (re-search-forward "[^ ]+:[0-9]+" nil t) @@ -415,7 +436,7 @@ to virtual article number.") ;; Ensure a trailing \t. (end-of-line) - (or (= (char-after (1- (point))) ?\t) + (or (eq (char-after (1- (point))) ?\t) (insert ?\t))) @@ -434,19 +455,24 @@ 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 (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)))) @@ -455,7 +481,11 @@ 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 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 @@ -491,14 +521,15 @@ 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 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 @@ -569,7 +600,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))) )) - )) + )) @@ -627,13 +658,12 @@ 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)) (setq articles (list articles))) - (let ((carticles (mapcar (lambda (g) (list g)) - nnvirtual-component-groups)) + (let ((carticles (mapcar 'list nnvirtual-component-groups)) a i j article entry) (while (setq a (pop articles)) (if (atom a) @@ -646,8 +676,8 @@ the result." (setq entry (assoc (car article) carticles)) (setcdr entry (cons (cdr article) (cdr entry)))) (setq i (1+ i)))) - (mapcar (lambda (x) (setcdr x (nreverse (cdr x)))) - carticles) + (mapc (lambda (x) (setcdr x (nreverse (cdr x)))) + carticles) carticles)) @@ -691,7 +721,7 @@ based on the marks on the component groups." tot (+ tot size) M (max M size)))) nnvirtual-component-groups) - + ;; Number of articles in the virtual group. (setq nnvirtual-mapping-len tot) @@ -787,4 +817,5 @@ based on the marks on the component groups." (provide 'nnvirtual) +;;; arch-tag: ca8c8ad9-1bd8-4b0f-9722-90dc645a45f5 ;;; nnvirtual.el ends here