;;; nnkiboze.el --- select virtual news access for Gnus;; Copyright (C) 1995 Free Software Foundation, Inc.;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>;; 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'gnus-score)(defvarnnkiboze-directory(expand-file-name(orgnus-article-save-directory"~/News/"))"nnkiboze will put its files in this directory.")(defconstnnkiboze-version"nnkiboze 1.0""Version numbers of this version of nnkiboze.")(defvarnnkiboze-current-groupnil)(defvarnnkiboze-current-score-group"")(defvarnnkiboze-status-string"");;; Interface functions.(defunnnkiboze-retrieve-headers(articles&optionalgroupserver)(nnkiboze-possibly-change-newsgroupsgroup)(ifgnus-nov-is-evilnil(if(stringp(cararticles))'headers(let((first(cararticles))(last(progn(while(cdrarticles)(setqarticles(cdrarticles)))(cararticles)))(nov(nnkiboze-nov-file-name)))(if(file-exists-pnov)(save-excursion(set-buffernntp-server-buffer)(erase-buffer)(insert-file-contentsnov)(goto-char(point-min))(while(and(not(eobp))(<first(read(current-buffer))))(forward-line1))(beginning-of-line)(if(not(eobp))(delete-region1(point)))(while(and(not(eobp))(>=last(read(current-buffer))))(forward-line1))(beginning-of-line)(if(not(eobp))(delete-region(point)(point-max)))'nov))))))(defunnnkiboze-open-server(newsgroups&optionalsomething)"Open a virtual newsgroup that contains NEWSGROUPS."(gnus-make-directorynnkiboze-directory)(nnheader-init-server-buffer))(defunnnkiboze-close-server(&restdum)"Close news server."t)(defalias'nnkiboze-request-quit(symbol-function'nnkiboze-close-server))(defunnnkiboze-server-opened(&optionalserver)"Return server process status, T or NIL.If the stream is opened, return T, otherwise return NIL."(andnntp-server-buffer(get-buffernntp-server-buffer)))(defunnnkiboze-status-message(&optionalserver)"Return server status response as string."nnkiboze-status-string)(defunnnkiboze-request-article(article&optionalnewsgroupserverbuffer)"Select article by message number."(nnkiboze-possibly-change-newsgroupsnewsgroup)(if(not(numberparticle));; This is a real kludge. It might not work at times, but it;; does no harm I think. The only alternative is to offer no;; article fetching by message-id at all.(nntp-request-articlearticlenewsgroupgnus-nntp-serverbuffer)(let*((header(gnus-get-header-by-numberarticle))(xref(mail-header-xrefheader))igroupiarticle)(orxref(error"nnkiboze: No xref"))(or(string-match" \\([^ ]+\\):\\([0-9]+\\)"xref)(error"nnkiboze: Malformed xref"))(setqigroup(substringxref(match-beginning1)(match-end1)))(setqiarticle(string-to-int(substringxref(match-beginning2)(match-end2))))(and(gnus-request-groupigroupt)(gnus-request-articleiarticleigroupbuffer)))))(defunnnkiboze-request-group(group&optionalserverdont-check)"Make GROUP the current newsgroup."(nnkiboze-possibly-change-newsgroupsgroup)(ifdont-check()(let((nov-file(nnkiboze-nov-file-name))begendtotal)(save-excursion(set-buffernntp-server-buffer)(erase-buffer)(if(not(file-exists-pnov-file))(insert(format"211 0 0 0 %s\n"group))(insert-file-contentsnov-file)(if(zerop(buffer-size))(insert(format"211 0 0 0 %s\n"group))(goto-char(point-min))(and(looking-at"[0-9]+")(setqbeg(read(current-buffer))))(goto-char(point-max))(and(re-search-backward"^[0-9]"nilt)(setqend(read(current-buffer))))(setqtotal(count-lines(point-min)(point-max)))(erase-buffer)(insert(format"211 %d %d %d %s\n"totalbegendgroup)))))))t)(defunnnkiboze-close-group(group&optionalserver)(nnkiboze-possibly-change-newsgroupsgroup);; Remove NOV lines of articles that are marked as read.(if(or(not(file-exists-p(nnkiboze-nov-file-name)))(not(eqmajor-mode'gnus-summary-mode)))()(save-excursion(let((unreadsgnus-newsgroup-unreads)(unselectedgnus-newsgroup-unselected))(set-buffer(get-buffer-create"*nnkiboze work*"))(buffer-disable-undo(current-buffer))(erase-buffer)(let((cur(current-buffer))article)(insert-file-contents(nnkiboze-nov-file-name))(goto-char(point-min))(while(looking-at"[0-9]+")(if(or(memq(setqarticle(readcur))unreads)(memqarticleunselected))(forward-line1)(delete-region(progn(beginning-of-line)(point))(progn(forward-line1)(point)))))(write-file(nnkiboze-nov-file-name))(kill-buffer(current-buffer)))))(setqnnkiboze-current-groupnil)))(defunnnkiboze-request-list(&optionalserver)(setqnnkiboze-status-string"nnkiboze: LIST is not implemented.")nil)(defunnnkiboze-request-newgroups(date&optionalserver)"List new groups."(setqnnkiboze-status-string"NEWGROUPS is not supported.")nil)(defunnnkiboze-request-list-newsgroups(&optionalserver)(setqnnkiboze-status-string"nnkiboze: LIST NEWSGROUPS is not implemented.")nil)(defalias'nnkiboze-request-post'nntp-request-post)(defalias'nnkiboze-request-post-buffer'nntp-request-post-buffer);;; Internal functions.(defunnnkiboze-possibly-change-newsgroups(group)(setqnnkiboze-current-groupgroup))(defunnnkiboze-prefixed-name(group)(gnus-group-prefixed-namegroup'(nnkiboze"")));;;###autoload(defunnnkiboze-generate-groups()"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groupsFinds out what articles are to be part of the nnkiboze groups."(interactive)(let((nnmail-spool-filenil)(gnus-use-dribble-filenil)(gnus-read-active-filet)(gnus-expert-usert))(gnus))(let*((gnus-newsrc-alist(gnus-copy-sequencegnus-newsrc-alist))(newsrcgnus-newsrc-alist))(whilenewsrc(if(string-match"nnkiboze"(car(carnewsrc)))(nnkiboze-generate-group(car(carnewsrc))))(setqnewsrc(cdrnewsrc)))))(defunnnkiboze-score-file(group)(list(expand-file-name(concatgnus-kill-files-directorynnkiboze-current-score-group"."gnus-score-file-suffix))))(defunnnkiboze-generate-group(group)(let*((info(nth2(gnus-gethashgroupgnus-newsrc-hashtb)))(newsrc-file(concatnnkiboze-directorygroup".newsrc"))(nov-file(concatnnkiboze-directorygroup".nov"))(regexp(nth1(nth4info)))(gnus-expert-usert)(gnus-large-newsgroupnil)(gnus-score-find-score-files-function'nnkiboze-score-file)gnus-select-group-hookgnus-summary-prepare-hookgnus-thread-sort-functionsgnus-show-threadsgnus-visualmethodnnkiboze-newsrcnov-buffergnamenewsrcactiveginfolowest)(setqnnkiboze-current-score-groupgroup)(orinfo(error"No such group: %s"group))(and(file-exists-pnewsrc-file)(loadnewsrc-file))(save-excursion(set-buffer(setqnov-buffer(find-file-noselectnov-file)))(buffer-disable-undo(current-buffer)));; Go through the active hashtb and add new all groups that match the ;; kiboze regexp.(mapatoms(lambda(group)(if(and(string-matchregexp(setqgname(symbol-namegroup))); Match(not(assocgnamennkiboze-newsrc)); It isn't registered(numberp(car(symbol-valuegroup))); It is active(not(string-match"^nnkiboze:"gname))); Exclude kibozes(setqnnkiboze-newsrc(cons(consgname(1-(car(symbol-valuegroup))))nnkiboze-newsrc))))gnus-active-hashtb)(setqnewsrcnnkiboze-newsrc)(whilenewsrc(if(not(setqactive(gnus-gethash(car(carnewsrc))gnus-active-hashtb)))(setqnnkiboze-newsrc(delq(carnewsrc)nnkiboze-newsrc))(switch-to-buffergnus-group-buffer)(gnus-group-jump-to-group(car(carnewsrc)))(if(and(setqginfo(nth2(gnus-gethash(gnus-group-group-name)gnus-newsrc-hashtb)))(nth3ginfo))(setcar(nthcdr3ginfo)nil))(if(not(and(or(notginfo)(>(length(gnus-list-of-unread-articles(carginfo)))0))(progn(gnus-group-select-groupnil)(eqmajor-mode'gnus-summary-mode))))()(setqlowest(cdr(carnewsrc)))(setqmethod(gnus-find-method-for-groupgnus-newsgroup-name))(and(eqmethodgnus-select-method)(setqmethodnil))(whilegnus-newsgroup-scored(if(>(car(cargnus-newsgroup-scored))lowest)(nnkiboze-enter-novnov-buffer(gnus-get-header-by-number(car(cargnus-newsgroup-scored)))(ifmethod(gnus-group-prefixed-namegnus-newsgroup-namemethod)gnus-newsgroup-name)))(setqgnus-newsgroup-scored(cdrgnus-newsgroup-scored)))(gnus-summary-quit)))(setcdr(carnewsrc)(caractive))(setqnewsrc(cdrnewsrc)))(set-buffernov-buffer)(save-buffer)(kill-buffer(current-buffer))(set-buffer(get-buffer-create"*nnkiboze work*"))(buffer-disable-undo(current-buffer))(erase-buffer)(insert"(setq nnkiboze-newsrc '"(prin1-to-stringnnkiboze-newsrc)")\n")(write-filenewsrc-file)(kill-buffer(current-buffer))(switch-to-buffergnus-group-buffer)(gnus-group-list-groups5nil)))(defunnnkiboze-enter-nov(bufferheadergroup)(save-excursion(set-bufferbuffer)(goto-char(point-max))(let((xref(mail-header-xrefheader))(prefix(gnus-group-real-prefixgroup))(firstt)article)(if(zerop(forward-line-1))(progn(setqarticle(1+(read(current-buffer))))(forward-line1))(setqarticle1))(insert(int-to-stringarticle)"\t"(or(mail-header-subjectheader)"")"\t"(or(mail-header-fromheader)"")"\t"(or(mail-header-dateheader)"")"\t"(or(mail-header-idheader)"")"\t"(or(mail-header-referencesheader)"")"\t"(int-to-string(or(mail-header-charsheader)0))"\t"(int-to-string(or(mail-header-linesheader)0))"\t")(if(or(notxref)(equal""xref))(insert"Xref: "(system-name)" "group":"(int-to-string(mail-header-numberheader))"\t\n")(insert(mail-header-xrefheader)"\t\n")(search-backward"\t"nilt)(search-backward"\t"nilt)(while(re-search-forward"[^ ]+:[0-9]+"(save-excursion(end-of-line)(point))t)(iffirst;; The first xref has to be the group this article;; really came for - this is the article nnkiboze;; will request when it is asked for the article.(save-excursion(goto-char(match-beginning0))(insertprefixgroup":"(int-to-string(mail-header-numberheader))" ")(setqfirstnil)))(save-excursion(goto-char(match-beginning0))(insertprefix)))))))(defunnnkiboze-nov-file-name()(concatnnkiboze-directory(nnkiboze-prefixed-namennkiboze-current-group)".nov"))(provide'nnkiboze);;; nnkiboze.el ends here