- (while headers
- (setq header (car headers)
- headers (cdr headers))
- (insert (int-to-string (header-number header)) "\t"
- (or (header-subject header) "") "\t"
- (or (header-from header) "") "\t"
- (or (header-date header) "") "\t"
- (or (header-id header) "") "\t"
- (or (header-references header) "") "\t"
- (int-to-string (or (header-chars header) 0)) "\t"
- (int-to-string (or (header-lines header) 0)) "\t"
- (if (header-xref header)
- (concat "Xref: " (header-xref header) "\t")
- "") "\n")))))
-
-(defun nnvirtual-possibly-change-newsgroups (group regexp &optional check)
- (let ((inf t))
- (or (not group)
- (and nnvirtual-current-group
- (string= group nnvirtual-current-group))
- (and (setq inf (assoc group nnvirtual-group-alist))
- (string= (nth 3 inf) regexp)
- (progn
- (setq nnvirtual-current-group (car inf))
- (setq nnvirtual-current-groups (nth 1 inf))
- (setq nnvirtual-current-mapping (nth 2 inf)))))
- (if (or (not check) (not inf))
- (progn
- (and inf (setq nnvirtual-group-alist
- (delq inf nnvirtual-group-alist)))
- (setq nnvirtual-current-mapping nil)
- (setq nnvirtual-current-group group)
- (let ((newsrc gnus-newsrc-alist))
- (setq nnvirtual-current-groups nil)
- (while newsrc
- (and (string-match regexp (car (car newsrc)))
- (not (string= (gnus-group-real-name (car (car newsrc)))
- nnvirtual-current-group))
- (setq nnvirtual-current-groups
- (cons (car (car newsrc)) nnvirtual-current-groups)))
- (setq newsrc (cdr newsrc))))
- (if nnvirtual-current-groups
- (progn
- (nnvirtual-create-mapping group)
- (setq nnvirtual-group-alist
- (cons (list group nnvirtual-current-groups
- nnvirtual-current-mapping regexp)
- nnvirtual-group-alist)))
- (setq nnvirtual-status-string
- (format
- "nnvirtual: No newsgroups for this virtual newsgroup"))))))
- nnvirtual-current-groups)
-
-(defun nnvirtual-create-mapping (group)
- (let* ((group (gnus-group-prefixed-name group (list 'nnvirtual "")))
- (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
- (groups nnvirtual-current-groups)
- (offset 0)
- reads unread igroup itotal ireads)
- ;; The virtual group doesn't exist. (?)
- (or info (error "No such group: %s" group))
- (setq nnvirtual-current-mapping nil)
- (while groups
- ;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (setq igroup (car groups))
- (let ((info (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb)))
- (active (gnus-gethash igroup gnus-active-hashtb)))
- ;; See if the group has had its active list read this session
- ;; if not, we do it now.
- (if (null active)
- (if (gnus-activate-newsgroup igroup)
- (progn
- (gnus-get-unread-articles-in-group
- info (gnus-gethash igroup gnus-active-hashtb))
- (setq active (gnus-gethash igroup gnus-active-hashtb)))
- (message "Couldn't open component group %s" igroup)
- (ding)))
- (if (null active)
- ()
- ;; And then we do the mapping for this component group. If
- ;; you feel tempte to cast your eyes to the soup below -
- ;; don't. It'll hurt your soul. Suffice to say that it
- ;; assigns ranges of nnvirtual article numbers to the
- ;; different component groups. To get the article number
- ;; from the nnvirtual number, one does something like
- ;; (+ (- number offset) (car active)), where `offset' is the
- ;; slice the mess below assigns, and active is the lowest
- ;; active article in the component group.
- (setq itotal (1+ (- (cdr active) (car active))))
- (if (setq ireads (nth 2 info))
- (let ((itreads
- (if (not (listp (cdr ireads)))
- (setq ireads (list (cons (car ireads) (cdr ireads))))
- (setq ireads (copy-alist ireads)))))
- (if (< (or (and (numberp (car ireads)) (car ireads))
- (cdr (car ireads))) (car active))
- (setq ireads (setq itreads (cdr ireads))))
- (if (and ireads (< (or (and (numberp (car ireads))
- (car ireads))
- (car (car ireads))) (car active)))
- (setcar (or (and (numberp (car ireads)) ireads)
- (car ireads)) (1+ (car active))))
- (while itreads
- (setcar (or (and (numberp (car itreads)) itreads)
- (car itreads))
- (+ (- (or (and (numberp (car itreads)) (car itreads))
- (car (car itreads))) (car active)) offset))
- (if (not (numberp (car itreads)))
- (setcdr (car itreads)
- (+ (- (cdr (car itreads)) (car active)) offset)))
- (setq itreads (cdr itreads)))
- (setq reads (nconc reads ireads))))
- (setq offset (+ offset (1- itotal)))
- (setq nnvirtual-current-mapping
- (cons (list offset igroup (car active))
- nnvirtual-current-mapping)))
- (setq groups (cdr groups))))
- (setq nnvirtual-current-mapping
- (nreverse nnvirtual-current-mapping))
- (gnus-sethash group (cons 1 offset) gnus-active-hashtb)
- (setcar (nthcdr 2 info) reads)
-
- ;; Then we deal with the marks.
- (let ((map nnvirtual-current-mapping)
- (marks '(tick dormant reply expire score))
- (offset 0)
- tick dormant reply expire score marked active)
- (while map
- (setq igroup (nth 1 (car map)))
- (setq active (nth 2 (car map)))
- (setq marked (nth 3 (nth 2 (gnus-gethash igroup gnus-newsrc-hashtb))))
- (let ((m marks))
- (while m
- (and (assq (car m) marked)
- (set (car m)
- (nconc (mapcar
- (lambda (art)
- (if (numberp art)
- (if (< art active)
- 0 (+ (- art active) offset))
- (cons (+ (- (car art) active) offset)
- (cdr art))))
- (cdr (assq (car m) marked)))
- (symbol-value (car m)))))
- (setq m (cdr m))))
- (setq offset (car (car map)))
- (setq map (cdr map)))
- ;; Put the list of marked articles in the info of the virtual group.
- (let ((m marks)
- marked)
- (while m
- (and (symbol-value (car m))
- (setq marked (cons (cons (car m) (symbol-value (car m)))
- marked)))
- (setq m (cdr m)))
- (if (nthcdr 3 info)
- (setcar (nthcdr 3 info) marked)
- (setcdr (nthcdr 2 info) (list marked)))))))