xemacs-beta: lisp/gnus/nnvirtual.el comparison

comparison lisp/gnus/nnvirtual.el @ 108:360340f9fd5f r20-1b6

Import from CVS: tag r20-1b6

author	cvs
date	Mon, 13 Aug 2007 09:18:39 +0200
parents	0d2f883870bc
children	fe104dbd9147

comparison

equal deleted inserted replaced

-:523141596bda
+:360340f9fd5f
 (save-excursion
 (set-buffer nntp-server-buffer)
 (erase-buffer)
 (if (stringp (car articles))
 	  'headers
 	(let ((vbuf (nnheader-set-temp-buffer
 		     (get-buffer-create " *virtual headers*")))
 	      (carticles (nnvirtual-partition-sequence articles))
 	      (system-name (system-name))
 	      cgroup carticle article result prefix)
 	  (while carticles
 	      ;; 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
 		(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?
 	 ((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)))))
 	   '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)
 		(gnus-request-article-this-buffer (cdr amap) cgroup))
 	    (gnus-request-article (cdr amap) cgroup))))))))
 (t
 (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-mapping-len nnvirtual-mapping-len group))))
 (deffoo nnvirtual-request-type (group &optional article)
 (if (not article)
 	       (= 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))))
 (nnvirtual-update-read-and-marked t t))
 t)
 (deffoo nnvirtual-request-list (&optional server)
 (nnheader-report 'nnvirtual "LIST is not implemented."))
 	  (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
 "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."
 (when nnvirtual-current-group
 (let ((unreads (and read-p
 			(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
 	(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))))))
 	  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."
 (let ((cnt 0)
 	(tot 0)
 	(M 0)
 (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
 	   (nreverse
 	    (mapcar (lambda (entry)
 		      (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))
 (while actives
 (setq size (car actives))

Mercurial > hg > xemacs-beta

comparison lisp/gnus/nnvirtual.el @ 108:360340f9fd5f r20-1b6