(require 'nntp)
(require 'nnheader)
(require 'gnus)
+(require 'nnoo)
+(require 'gnus-util)
+(require 'gnus-start)
+(require 'gnus-sum)
(eval-when-compile (require 'cl))
-(defvar nnvirtual-always-rescan nil
+(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-component-regexp nil
+ "*Regexp to match component groups.")
+
+(defvoo nnvirtual-component-groups nil
+ "Component group in this nnvirtual group.")
+
\f
-(defconst nnvirtual-version "nnvirtual 1.0"
- "Version number of this version of nnvirtual.")
+(defconst nnvirtual-version "nnvirtual 1.0")
-(defvar nnvirtual-group-alist nil)
-(defvar nnvirtual-current-group nil)
-(defvar nnvirtual-component-groups nil)
-(defvar nnvirtual-mapping nil)
+(defvoo nnvirtual-current-group nil)
+(defvoo nnvirtual-mapping nil)
-(defvar nnvirtual-status-string "")
+(defvoo nnvirtual-status-string "")
(eval-and-compile
(autoload 'gnus-cache-articles-in-group "gnus-cache"))
;;; Interface functions.
-(defun nnvirtual-retrieve-headers (articles &optional newsgroup server fetch-old)
- (when (nnvirtual-possibly-change-group newsgroup server t)
+(nnoo-define-basics nnvirtual)
+
+(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
+ server fetch-old)
+ (when (nnvirtual-possibly-change-server server)
(save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
(if (stringp (car articles))
'headers
(let ((vbuf (nnheader-set-temp-buffer
'nov)
(kill-buffer vbuf)))))))
-(defun nnvirtual-open-server (server &optional something)
- (nnheader-init-server-buffer))
-
-(defun nnvirtual-close-server (&rest dum)
- t)
-
-(defun nnvirtual-request-close ()
- (setq nnvirtual-current-group nil
- nnvirtual-component-groups nil
- nnvirtual-mapping nil
- nnvirtual-group-alist nil)
- t)
-
-(defun nnvirtual-server-opened (&optional server)
- (and nntp-server-buffer
- (get-buffer nntp-server-buffer)))
-
-(defun nnvirtual-status-message (&optional server)
- nnvirtual-status-string)
-
-(defun nnvirtual-request-article (article &optional group server buffer)
- (when (and (nnvirtual-possibly-change-group group server t)
+(deffoo nnvirtual-request-article (article &optional group server buffer)
+ (when (and (nnvirtual-possibly-change-server server)
(numberp article))
(let* ((amap (assq article nnvirtual-mapping))
(cgroup (cadr amap)))
(gnus-request-article-this-buffer (caddr amap) cgroup))
(gnus-request-article (caddr amap) cgroup)))))))
-(defun nnvirtual-request-group (group &optional server dont-check)
+(deffoo nnvirtual-open-server (server &optional defs)
+ (unless (assq 'nnvirtual-component-regexp defs)
+ (push `(nnvirtual-component-regexp ,server)
+ defs))
+ (nnoo-change-server 'nnvirtual server defs)
+ (if nnvirtual-component-groups
+ t
+ (setq nnvirtual-mapping nil)
+ (when nnvirtual-component-regexp
+ ;; Go through the newsrc alist and find all component groups.
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ group)
+ (while (setq group (car (pop newsrc)))
+ (when (string-match nnvirtual-component-regexp group) ; Match
+ ;; Add this group to the list of component groups.
+ (setq nnvirtual-component-groups
+ (cons group (delete group nnvirtual-component-groups)))))))
+ (if (not nnvirtual-component-groups)
+ (nnheader-report 'nnvirtual "No component groups: %s" server)
+ t)))
+
+(deffoo nnvirtual-request-group (group &optional server dont-check)
+ (nnvirtual-possibly-change-server server)
+ (setq nnvirtual-component-groups
+ (delete (nnvirtual-current-group) nnvirtual-component-groups))
(cond
- ((null (nnvirtual-possibly-change-group
- group server
- (if nnvirtual-always-rescan nil (not dont-check))))
+ ((null nnvirtual-component-groups)
(setq nnvirtual-current-group nil)
(nnheader-report 'nnvirtual "No component groups in %s" group))
(t
+ (unless dont-check
+ (nnvirtual-create-mapping))
+ (setq nnvirtual-current-group group)
(let ((len (length nnvirtual-mapping)))
(nnheader-insert "211 %d 1 %d %s\n" len len group)))))
-(defun nnvirtual-request-type (group &optional article)
- (when (nnvirtual-possibly-change-group group nil t)
- (if (not article)
- 'unknown
- (let ((mart (assq article nnvirtual-mapping)))
- (when mart
- (gnus-request-type (cadr mart) (car mart)))))))
-
-(defun nnvirtual-request-update-mark (group article mark)
- (when (nnvirtual-possibly-change-group group nil t)
- (let* ((nart (assq article nnvirtual-mapping))
- (cgroup (cadr nart))
- ;; The component group might be a virtual group.
- (nmark (gnus-request-update-mark cgroup (caddr nart) mark)))
- (when (and (= mark nmark)
- (gnus-group-auto-expirable-p cgroup))
- (setq mark gnus-expirable-mark))))
+(deffoo nnvirtual-request-type (group &optional article)
+ (if (not article)
+ 'unknown
+ (let ((mart (assq article nnvirtual-mapping)))
+ (when mart
+ (gnus-request-type (cadr mart) (car mart))))))
+
+(deffoo nnvirtual-request-update-mark (group article mark)
+ (let* ((nart (assq article nnvirtual-mapping))
+ (cgroup (cadr nart))
+ ;; The component group might be a virtual group.
+ (nmark (gnus-request-update-mark cgroup (caddr nart) mark)))
+ (when (and nart
+ (= mark nmark)
+ (gnus-group-auto-expirable-p cgroup))
+ (setq mark gnus-expirable-mark)))
mark)
-(defun nnvirtual-close-group (group &optional server)
- (when (nnvirtual-possibly-change-group group server t)
+(deffoo nnvirtual-close-group (group &optional server)
+ (when (and (nnvirtual-possibly-change-server server)
+ (not (gnus-ephemeral-group-p group)))
;; Copy (un)read articles.
(nnvirtual-update-reads)
;; We copy the marks from this group to the component
(nnvirtual-update-marked))
t)
-(defun nnvirtual-request-list (&optional server)
+(deffoo nnvirtual-request-list (&optional server)
(nnheader-report 'nnvirtual "LIST is not implemented."))
-(defun nnvirtual-request-newgroups (date &optional server)
+(deffoo nnvirtual-request-newgroups (date &optional server)
(nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
-(defun nnvirtual-request-list-newsgroups (&optional server)
+(deffoo nnvirtual-request-list-newsgroups (&optional server)
(nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
-(defun nnvirtual-request-update-info (group info &optional server)
- (when (nnvirtual-possibly-change-group group server)
+(deffoo nnvirtual-request-update-info (group info &optional server)
+ (when (nnvirtual-possibly-change-server server)
(let ((map nnvirtual-mapping)
(marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists))
reads mr m op)
(if (cdadr mr)
(setq mr (cdr mr))
(setcdr mr (cddr mr))))
-
+
;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(setcar (nthcdr 3 info) marks)
(setcdr (nthcdr 2 info) (list marks))))
t)))
-(defun nnvirtual-catchup-group (group &optional server all)
- (nnvirtual-possibly-change-group group server t)
- (let ((gnus-group-marked nnvirtual-component-groups)
+(deffoo nnvirtual-catchup-group (group &optional server all)
+ (nnvirtual-possibly-change-server server)
+ (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
(gnus-expert-user t))
;; Make sure all groups are activated.
(mapcar
(set-buffer gnus-group-buffer)
(gnus-group-catchup-current nil all))))
-(defun nnvirtual-find-group-art (group article)
+(deffoo nnvirtual-find-group-art (group article)
"Return the real group and article for virtual GROUP and ARTICLE."
- (nnvirtual-possibly-change-group group nil t)
(let ((mart (assq article nnvirtual-mapping)))
(when mart
(cons (cadr mart) (caddr mart)))))
header)
(erase-buffer)
(while (setq header (pop headers))
- (insert (int-to-string (mail-header-number header)) "\t"
- (or (mail-header-subject header) "") "\t"
- (or (mail-header-from header) "") "\t"
- (or (mail-header-date header) "") "\t"
- (or (mail-header-id header) "") "\t"
- (or (mail-header-references header) "") "\t"
- (int-to-string (or (mail-header-chars header) 0)) "\t"
- (int-to-string (or (mail-header-lines header) 0)) "\t"
- (if (mail-header-xref header)
- (concat "Xref: " (mail-header-xref header) "\t")
- "") "\n")))))
-
-(defun nnvirtual-possibly-change-group (group regexp &optional check)
- (let ((inf t))
- (when (or (not (equal group nnvirtual-current-group))
- check)
- (and (setq inf (assoc group nnvirtual-group-alist))
- regexp
- (string= (nth 3 inf) regexp)
- (progn
- (setq nnvirtual-current-group (car inf))
- (setq nnvirtual-component-groups (nth 1 inf))
- (setq nnvirtual-mapping (nth 2 inf))))
- (when (and regexp (not inf))
- (and inf (setq nnvirtual-group-alist
- (delq inf nnvirtual-group-alist)))
- (setq nnvirtual-mapping nil)
- (setq nnvirtual-current-group group)
- (let ((newsrc gnus-newsrc-alist)
- (virt-group (gnus-group-prefixed-name
- nnvirtual-current-group '(nnvirtual ""))))
- (setq nnvirtual-component-groups nil)
- (while newsrc
- (and (string-match regexp (caar newsrc))
- (not (string= (caar newsrc) virt-group))
- (setq nnvirtual-component-groups
- (cons (caar newsrc)
- (delete (caar newsrc)
- nnvirtual-component-groups))))
- (setq newsrc (cdr newsrc))))
- (if nnvirtual-component-groups
- (progn
- (nnvirtual-create-mapping)
- (setq nnvirtual-group-alist
- (cons (list group nnvirtual-component-groups
- nnvirtual-mapping regexp)
- nnvirtual-group-alist)))
- (nnheader-report 'nnvirtual "No component groups: %s" group)))))
- nnvirtual-component-groups)
+ (nnheader-insert-nov header)))))
+
+(defun nnvirtual-possibly-change-server (server)
+ (or (not server)
+ (nnoo-current-server-p 'nnvirtual server)
+ (nnvirtual-open-server server)))
(defun nnvirtual-update-marked ()
"Copy marks from the virtual group to the component groups."
(let ((mark-lists gnus-article-mark-lists)
- (marks (gnus-info-marks (gnus-get-info
- (concat "nnvirtual:"
- nnvirtual-current-group))))
+ (marks (gnus-info-marks (gnus-get-info (nnvirtual-current-group))))
type list mart cgroups)
(while (setq type (cdr (pop mark-lists)))
(setq list (gnus-uncompress-range (cdr (assq type marks))))
"Copy (un)reads from the current group to the component groups."
(let ((groups (mapcar (lambda (g) (list g)) nnvirtual-component-groups))
(articles (gnus-list-of-unread-articles
- (concat "nnvirtual:" nnvirtual-current-group)))
+ (nnvirtual-current-group)))
m)
(while articles
(setq m (assq (pop articles) nnvirtual-mapping))
(while groups
(gnus-update-read-articles (caar groups) (cdr (pop groups))))))
+(defun nnvirtual-current-group ()
+ "Return the prefixed name of the current nnvirtual group."
+ (concat "nnvirtual:" nnvirtual-current-group))
+
(defsubst nnvirtual-marks (article marks)
"Return a list of mark types for ARTICLE."
(let (out)
'nconc
(mapcar
(lambda (g)
- (when (setq active (gnus-activate-group g))
+ (when (and (setq active (gnus-activate-group g))
+ (> (cdr active) (car active)))
(setq unreads (gnus-list-of-unread-articles g)
marks (gnus-uncompress-marks
(gnus-info-marks (gnus-get-info g))))
nnvirtual-component-groups))
(lambda (m1 m2)
(< (car m1) (car m2)))))
- (i 0))
+ (i 0))
(setq nnvirtual-mapping map)
;; Set the virtual article numbers.
(while (setq m (pop map))
projects / gnus / blobdiff