;;; nnvirtual.el --- virtual newsgroups access for Gnus;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>;; Keywords: news;; This file is part of GNU Emacs.;; GNU Emacs is free software; you can redistribute it and/or modify;; it under the terms of the GNU General Public License as published by;; the Free Software Foundation; either version 2, or (at your option);; any later version.;; GNU Emacs is distributed in the hope that it will be useful,;; but WITHOUT ANY WARRANTY; without even the implied warranty of;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the;; GNU General Public License for more details.;; You should have received a copy of the GNU General Public License;; along with GNU Emacs; see the file COPYING. If not, write to the;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,;; Boston, MA 02111-1307, USA.;;; Commentary:;; The other access methods (nntp, nnspool, etc) are general news;; access methods. This module relies on Gnus and can not be used;; separately.;;; Code:(require'nntp)(require'nnheader)(require'gnus)(require'nnoo)(eval-when-compile(require'cl))(nnoo-declarennvirtual)(defvoonnvirtual-always-rescannil"*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 articlesin a component group after the virtual group has been activated, theread articles from the component group will show up when you enter thevirtual group.")(defvoonnvirtual-component-regexpnil"*Regexp to match component groups.")(defconstnnvirtual-version"nnvirtual 1.0")(defvoonnvirtual-current-groupnil)(defvoonnvirtual-component-groupsnil)(defvoonnvirtual-mappingnil)(defvoonnvirtual-status-string"")(eval-and-compile(autoload'gnus-cache-articles-in-group"gnus-cache"));;; Interface functions.(nnoo-define-basicsnnvirtual)(deffoonnvirtual-retrieve-headers(articles&optionalnewsgroupserverfetch-old)(when(nnvirtual-possibly-change-serverserver)(save-excursion(set-buffernntp-server-buffer)(erase-buffer)(if(stringp(cararticles))'headers(let((vbuf(nnheader-set-temp-buffer(get-buffer-create" *virtual headers*")))(unfetched(mapcar(lambda(g)(listg))nnvirtual-component-groups))(system-name(system-name))cgrouparticleresultprefix)(whilearticles(setqarticle(assq(poparticles)nnvirtual-mapping))(when(and(setqcgroup(cadrarticle))(gnus-check-server(gnus-find-method-for-groupcgroup)t)(gnus-request-groupcgroupt))(setqprefix(gnus-group-real-prefixcgroup))(when(setqresult(gnus-retrieve-headers(list(caddrarticle))cgroupnil))(set-buffernntp-server-buffer)(if(zerop(buffer-size))(nconc(assqcgroupunfetched)(list(caddrarticle)));; 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(eqresult'headers)(nnvirtual-convert-headers))(goto-char(point-min))(while(not(eobp))(delete-region(point)(progn(readnntp-server-buffer)(point)))(princ(cararticle)(current-buffer))(beginning-of-line)(looking-at"[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")(goto-char(match-end0))(or(search-forward"\t"(save-excursion(end-of-line)(point))t)(end-of-line))(while(=(char-after(1-(point)))?)(forward-char-1)(delete-char1))(if(eolp)(progn(end-of-line)(or(=(char-after(1-(point)))?\t)(insert?\t))(insert"Xref: "system-name" "cgroup":")(princ(caddrarticle)(current-buffer))(insert"\t"))(insert"Xref: "system-name" "cgroup":")(princ(caddrarticle)(current-buffer))(insert" ")(if(not(string=""prefix))(while(re-search-forward"[^ ]+:[0-9]+"(save-excursion(end-of-line)(point))t)(save-excursion(goto-char(match-beginning0))(insertprefix))))(end-of-line)(or(=(char-after(1-(point)))?\t)(insert?\t)))(forward-line1))(set-buffervbuf)(goto-char(point-max))(insert-buffer-substringnntp-server-buffer)))));; In case some of the articles have expired or been;; cancelled, we have to mark them as read in the;; component group.(whileunfetched(when(cdarunfetched)(gnus-group-make-articles-read(caarunfetched)(sort(cdarunfetched)'<)))(setqunfetched(cdrunfetched)));; The headers are ready for reading, so they are inserted into;; the nntp-server-buffer, which is where Gnus expects to find;; them.(prog1(save-excursion(set-buffernntp-server-buffer)(erase-buffer)(insert-buffer-substringvbuf)'nov)(kill-buffervbuf)))))))(deffoonnvirtual-request-article(article&optionalgroupserverbuffer)(when(and(nnvirtual-possibly-change-serverserver)(numberparticle))(let*((amap(assqarticlennvirtual-mapping))(cgroup(cadramap)))(cond((notamap)(nnheader-report'nnvirtual"No such article: %s"article))((not(gnus-check-groupcgroup))(nnheader-report'nnvirtual"Can't open server where %s exists"cgroup))((not(gnus-request-groupcgroupt))(nnheader-report'nnvirtual"Can't open component group %s"cgroup))(t(ifbuffer(save-excursion(set-bufferbuffer)(gnus-request-article-this-buffer(caddramap)cgroup))(gnus-request-article(caddramap)cgroup)))))))(deffoonnvirtual-open-server(server&optionaldefs)(unless(assq'nnvirtual-component-regexpdefs)(push`(nnvirtual-component-regexp,server)defs))(nnoo-change-server'nnvirtualserverdefs)(ifnnvirtual-component-groupst(setqnnvirtual-mappingnil);; Go through the newsrc alist and find all component groups.(let((newsrc(cdrgnus-newsrc-alist))group)(while(setqgroup(car(popnewsrc)))(when(string-matchnnvirtual-component-regexpgroup); Match;; Add this group to the list of component groups.(setqnnvirtual-component-groups(consgroup(deletegroupnnvirtual-component-groups))))))(if(notnnvirtual-component-groups)(nnheader-report'nnvirtual"No component groups: %s"server)t)))(deffoonnvirtual-request-group(group&optionalserverdont-check)(nnvirtual-possibly-change-serverserver)(setqnnvirtual-component-groups(delete(nnvirtual-current-group)nnvirtual-component-groups))(cond((nullnnvirtual-component-groups)(setqnnvirtual-current-groupnil)(nnheader-report'nnvirtual"No component groups in %s"group))(t(unlessdont-check(nnvirtual-create-mapping))(setqnnvirtual-current-groupgroup)(let((len(lengthnnvirtual-mapping)))(nnheader-insert"211 %d 1 %d %s\n"lenlengroup)))))(deffoonnvirtual-request-type(group&optionalarticle)(if(notarticle)'unknown(let((mart(assqarticlennvirtual-mapping)))(whenmart(gnus-request-type(cadrmart)(carmart))))))(deffoonnvirtual-request-update-mark(grouparticlemark)(let*((nart(assqarticlennvirtual-mapping))(cgroup(cadrnart));; The component group might be a virtual group.(nmark(gnus-request-update-markcgroup(caddrnart)mark)))(when(andnart(=marknmark)(gnus-group-auto-expirable-pcgroup))(setqmarkgnus-expirable-mark)))mark)(deffoonnvirtual-close-group(group&optionalserver)(when(nnvirtual-possibly-change-serverserver);; Copy (un)read articles.(nnvirtual-update-reads);; We copy the marks from this group to the component;; groups here.(nnvirtual-update-marked))t)(deffoonnvirtual-request-list(&optionalserver)(nnheader-report'nnvirtual"LIST is not implemented."))(deffoonnvirtual-request-newgroups(date&optionalserver)(nnheader-report'nnvirtual"NEWGROUPS is not supported."))(deffoonnvirtual-request-list-newsgroups(&optionalserver)(nnheader-report'nnvirtual"LIST NEWSGROUPS is not implemented."))(deffoonnvirtual-request-update-info(groupinfo&optionalserver)(when(nnvirtual-possibly-change-serverserver)(let((mapnnvirtual-mapping)(marks(mapcar(lambda(m)(list(cdrm)))gnus-article-mark-lists))readsmrmop);; Go through the mapping.(whilemap(unless(nth3(setqm(popmap)));; Read article.(push(carm)reads));; Copy marks.(when(setqmr(nth4m))(whilemr(setcdr(setqop(assq(popmr)marks))(cons(carm)(cdrop))))));; Compress the marks and the reads.(setqmrmarks)(whilemr(setcdr(carmr)(gnus-compress-sequence(sort(cdr(popmr))'<))))(setcar(cddrinfo)(gnus-compress-sequence(nreversereads)));; Remove empty marks lists.(while(andmarks(not(cdarmarks)))(setqmarks(cdrmarks)))(setqmrmarks)(while(cdrmr)(if(cdadrmr)(setqmr(cdrmr))(setcdrmr(cddrmr))));; Enter these new marks into the info of the group.(if(nthcdr3info)(setcar(nthcdr3info)marks);; Add the marks lists to the end of the info.(whenmarks(setcdr(nthcdr2info)(listmarks))))t)))(deffoonnvirtual-catchup-group(group&optionalserverall)(nnvirtual-possibly-change-serverserver)(let((gnus-group-marked(copy-sequencennvirtual-component-groups))(gnus-expert-usert));; Make sure all groups are activated.(mapcar(lambda(g)(when(not(numberp(car(gnus-gethashggnus-newsrc-hashtb))))(gnus-activate-groupg)))nnvirtual-component-groups)(save-excursion(set-buffergnus-group-buffer)(gnus-group-catchup-currentnilall))))(deffoonnvirtual-find-group-art(grouparticle)"Return the real group and article for virtual GROUP and ARTICLE."(let((mart(assqarticlennvirtual-mapping)))(whenmart(cons(cadrmart)(caddrmart)))));;; Internal functions.(defunnnvirtual-convert-headers()"Convert HEAD headers into NOV headers."(save-excursion(set-buffernntp-server-buffer)(let*((dependencies(make-vector1000))(headers(gnus-get-newsgroup-headersdependencies))header)(erase-buffer)(while(setqheader(popheaders))(nnheader-insert-novheader)))))(defunnnvirtual-possibly-change-server(server)(or(notserver)(nnoo-current-server-p'nnvirtualserver)(nnvirtual-open-serverserver)))(defunnnvirtual-update-marked()"Copy marks from the virtual group to the component groups."(let((mark-listsgnus-article-mark-lists)(marks(gnus-info-marks(gnus-get-info(nnvirtual-current-group))))typelistmartcgroups)(while(setqtype(cdr(popmark-lists)))(setqlist(gnus-uncompress-range(cdr(assqtypemarks))))(setqcgroups(mapcar(lambda(g)(listg))nnvirtual-component-groups))(whilelist(nconc(assoc(cadr(setqmart(assq(poplist)nnvirtual-mapping)))cgroups)(list(caddrmart))))(whilecgroups(gnus-add-marked-articles(caarcgroups)type(cdarcgroups)nilt)(gnus-group-update-group(car(popcgroups))t)))))(defunnnvirtual-update-reads()"Copy (un)reads from the current group to the component groups."(let((groups(mapcar(lambda(g)(listg))nnvirtual-component-groups))(articles(gnus-list-of-unread-articles(nnvirtual-current-group)))m)(whilearticles(setqm(assq(poparticles)nnvirtual-mapping))(nconc(assoc(nth1m)groups)(list(nth2m))))(whilegroups(gnus-update-read-articles(caargroups)(cdr(popgroups))))))(defunnnvirtual-current-group()"Return the prefixed name of the current nnvirtual group."(concat"nnvirtual:"nnvirtual-current-group))(defsubstnnvirtual-marks(articlemarks)"Return a list of mark types for ARTICLE."(let(out)(whilemarks(when(memqarticle(cdarmarks))(push(caarmarks)out))(setqmarks(cdrmarks)))out))(defunnnvirtual-create-mapping()"Create an article mapping for the current group."(let*((divnil)mmarkslistarticleunreadsmarksactive(map(sort(apply'nconc(mapcar(lambda(g)(when(and(setqactive(gnus-activate-groupg))(>(cdractive)(caractive)))(setqunreads(gnus-list-of-unread-articlesg)marks(gnus-uncompress-marks(gnus-info-marks(gnus-get-infog))))(whengnus-use-cache(push(cons'cache(gnus-cache-articles-in-groupg))marks))(setqdiv(/(float(caractive))(if(zerop(cdractive))1(cdractive))))(mapcar(lambda(n)(list(*div(-n(caractive)))gn(and(memqnunreads)t)(inline(nnvirtual-marksnmarks))))(gnus-uncompress-rangeactive))))nnvirtual-component-groups))(lambda(m1m2)(<(carm1)(carm2)))))(i0))(setqnnvirtual-mappingmap);; Set the virtual article numbers.(while(setqm(popmap))(setcarm(setqarticle(incfi))))))(provide'nnvirtual);;; nnvirtual.el ends here