From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army knife of text editors" Newsgroups: gmane.emacs.bugs Subject: bug#64202: bug#66188: 29.1; Include Atom feed reader Date: Tue, 23 Apr 2024 01:44:44 +0300 Message-ID: <871q6xuieb.fsf@dsemy.com> References: <87v8fhmgvw.fsf@dsemy.com> <87r0hof9ll.fsf_-_@dsemy.com> <87jznfpom1.fsf@gmx.net> <874jejb2sg.fsf@dsemy.com> <87fry2pa1n.fsf@gmx.net> <87ttmhwxby.fsf@dsemy.com> <87wmrd9zcy.fsf@outlook.com> <875xyx5ksi.fsf@dsemy.com> <87sf219ntf.fsf@gmx.net> <87msrtkztg.fsf@outlook.com> <87ttm0mnku.fsf@dsemy.com> <87o7c7b0yf.fsf@dsemy.com> <87le79yl11.fsf@gmx.net> <87sf1eh53p.fsf@dsemy.com> <87ttl3wk81.fsf_-_@dsemy.com> <87il1b7nxl.fsf@dsemy.com> <8634ry50gw.fsf@gnu.org> <868r1bf3i1.fsf@gnu.org> <87mspnlez1.fsf_-_@ericabrahamsen.net> <87sezev9qi.fsf@dsemy.com> <87o7a2jdm7.fsf@ericabrahamsen.net> Reply-To: Daniel Semyonov Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="7127"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Eli Zaretskii , jimjoe@gmx.net, 66188@debbugs.gnu.org, 64202@debbugs.gnu.org To: Eric Abrahamsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Tue Apr 23 00:47:15 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rz2RO-0001bS-D4 for geb-bug-gnu-emacs@m.gmane-mx.org; Tue, 23 Apr 2024 00:47:14 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rz2Qy-0000il-6s; Mon, 22 Apr 2024 18:46:48 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rz2Qw-0000iB-7v for bug-gnu-emacs@gnu.org; Mon, 22 Apr 2024 18:46:46 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rz2Qv-00061L-VL for bug-gnu-emacs@gnu.org; Mon, 22 Apr 2024 18:46:45 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1rz2RB-0005rl-Lg; Mon, 22 Apr 2024 18:47:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Daniel Semyonov Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org, bugs@gnus.org Resent-Date: Mon, 22 Apr 2024 22:47:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 64202 X-GNU-PR-Package: emacs,gnus X-GNU-PR-Keywords: patch Original-Received: via spool by 64202-submit@debbugs.gnu.org id=B64202.171382599322332 (code B ref 64202); Mon, 22 Apr 2024 22:47:01 +0000 Original-Received: (at 64202) by debbugs.gnu.org; 22 Apr 2024 22:46:33 +0000 Original-Received: from localhost ([127.0.0.1]:48301 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rz2QZ-0005mi-Ke for submit@debbugs.gnu.org; Mon, 22 Apr 2024 18:46:32 -0400 Original-Received: from dsemy.com ([46.23.89.208]:28353) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1rz2QN-0005kv-Ny; Mon, 22 Apr 2024 18:46:16 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; s=dkim; bh=QoSKBSQIUn8Vr gMetafXOJNXHkAfWBeFR/IBiHICfeo=; h=date:references:in-reply-to: subject:cc:to:from; d=dsemy.com; b=l06KXr6rYfh2qX8GdJOuqLM3HdpoalHcfj7 Cqta1h7AJl0nB0FsEjnaK6JGov/8Pft24ADxdQlU6pwhAPH02dq6c11vytPLsh2QV6z3H/ c9CjVGHPjvF3TWTBGpEkOOJlmIUapfvqnSMSi31qn/DqlM5bf0SdGeEyjA01KpLASah+C9 ZgHklI2EPxfi3vg72Yz9EhFtoyidKvruv1ONVW0HTCh9YoDjeARPzEV/vRV6AsuOTw40F+ UqlxzPWsAnpHbHycsi2+RB+CAE0BNyG4ohyW6cSROBwZkvJYimGzmA+NNbHICyk2axK020 EVRVAOsaGZw9fj5awzYi/jFAZzw== Original-Received: from coldharbour.local ( [147.235.220.9]) by dsemy.com (OpenSMTPD) with ESMTPSA id 0b5c5fb0 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Tue, 23 Apr 2024 00:45:48 +0200 (CEST) Original-Received: from localhost (coldharbour.local [local]) by coldharbour.local (OpenSMTPD) with ESMTPA id f7fa5824; Mon, 22 Apr 2024 22:44:44 +0000 (UTC) In-Reply-To: <87o7a2jdm7.fsf@ericabrahamsen.net> (Eric Abrahamsen's message of "Sun, 21 Apr 2024 20:11:12 -0700") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:283854 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable >>>>> Eric Abrahamsen writes: > On 04/21/24 21:41 PM, Daniel Semyonov wrote: >>>>>>> Eric Abrahamsen writes: >>=20 >> > Eli Zaretskii writes: >> >> Ping! Ping! Eric, any comments? >>=20 >> > Yes, let's do it! My only comment right now is that the manual sho= uld >> > explicitly list the steps for creating an atom group: "B nnatom RE= T" and >> > insert URL without protocol. I still have dreams of fixing the gro= up >> > creation code to prompt for the address, but that can wait. >>=20 >> > Daniel, would you make that addition? >>=20 >> Does the following text (in the 'Atom' subsection of the Gnus manual) >> not suffice? >>=20 >> The =E2=80=98nnatom=E2=80=99 back end allows you to add HTTP or loca= l Atom feeds as >> Gnus servers (with a single group), as you would with any other meth= od, >> by supplying the location of the feed as the server address. Note, >> however, that the server address shouldn't be prefixed with or >> . > I think we need to at least make it clear that you can't create these > groups with "G m", which to me anyway is the "normal" way of making a > group. It wouldn't hurt to be more explicit about the fact that feeds > are created at the server level, not the group level. I'm not suggest= ing > anything radical, something like: > --8<---------------cut here---------------start------------->8---=20 > The =E2=80=98nnatom=E2=80=99 back end allows you to add HTTP or local= Atom feeds as Gnus > servers, in your Gnus init files or as foreign servers via "B" in the > *Group* buffer. The feed location is supplied as the server address, = and > each server only contains a single group. Note, however, that the ser= ver > address shouldn't be prefixed with or . > --8<---------------cut here---------------end--------------->8--- > Or something like that. WDYT? I gave it another thought and you're right, it should be more explicit. I've attached an updated patch but here's the new version of the paragraph (since I actually ended up being even more explicit): The =E2=80=98nnatom=E2=80=99 back end allows you to add HTTP or local Ato= m feeds as Gnus servers, by adding them to =E2=80=98gnus-secondary-select-methods=E2= =80=99 or as foreign servers by pressing "B" in the =E2=80=98*Group*=E2=80=99 buffer, = for example (*note Finding the News). The address of each server is its feed's location (though the address shouldn't be prefixed with or ) and each server contains a single group which holds the feed's entries. Daniel --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Gnus-Add-back-end-for-Atom-feeds-nnatom.patch Content-Description: patch >From 58486c54878ec0496fc5006406a6a3dd4ffae033 Mon Sep 17 00:00:00 2001 From: Daniel Semyonov Date: Wed, 21 Jun 2023 10:05:04 +0300 Subject: [PATCH] Gnus: Add back end for Atom feeds (nnatom) * lisp/gnus/gnus.el (gnus-valid-select-methods): Add entry for nnatom. * lisp/gnus/nnfeed.el: New file implementing an abstract web feed back end. * lisp/gnus/nnatom.el: New file implementing a back end for Atom feeds. * doc/misc/gnus.texi (Browsing the Web, Back End Interface): * etc/NEWS (Gnus): Document nnatom and nnfeed. --- doc/misc/gnus.texi | 77 +++++ etc/NEWS | 10 + lisp/gnus/gnus.el | 1 + lisp/gnus/nnatom.el | 276 ++++++++++++++++++ lisp/gnus/nnfeed.el | 683 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 1047 insertions(+) create mode 100644 lisp/gnus/nnatom.el create mode 100644 lisp/gnus/nnfeed.el diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 419a5390374..8aa7f855aea 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -715,6 +715,7 @@ Top * Web Searches:: Creating groups from articles that match a string. * RSS:: Reading RDF site summary. +* Atom:: Reading Atom Syndication Format feeds. Other Sources @@ -975,6 +976,7 @@ Top * Writing New Back Ends:: Extending old back ends. * Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end. * Mail-like Back Ends:: Some tips on mail back ends. +* Web Feed Back Ends:: Easily defining back ends for web feeds. Various File Formats @@ -17252,6 +17254,7 @@ Browsing the Web @menu * Web Searches:: Creating groups from articles that match a string. * RSS:: Reading RDF site summary. +* Atom:: Reading Atom Syndication Format feeds. @end menu The main caveat with all these web sources is that they probably won't @@ -17496,6 +17499,42 @@ RSS @end lisp +@node Atom +@subsection Atom +@cindex nnatom +@cindex Atom + +Some web sites provide an Atom Syndication Format feed. Atom is a web +feed format similar in function to RDF Site Summary (@pxref{RSS}). + +The @code{nnatom} back end allows you to add HTTP or local Atom feeds as +Gnus servers, by adding them to @code{gnus-secondary-select-methods} or +as foreign servers by pressing "B" in the @file{*Group*} buffer, for +example (@pxref{Finding the News}). The address of each server is its +feed's location (though the address shouldn't be prefixed with or +) and each server contains a single group which holds the +feed's entries. + +Features of @code{nnatom} include: + +@itemize @bullet + +@item +Server data is saved per-server in the @file{atom} sub-directory of +@file{gnus-directory}. + +@item +An article part is generated for both the summary and the content for +each entry in the feed. Content of all MIME types should be displayed +correctly through Gnus (as long as they are supported and the feed +specifies a MIME type). + +@item +Article modification and publish dates are tracked, and articles are +updated if changed. + +@end itemize + @node Other Sources @section Other Sources @@ -29997,6 +30036,7 @@ Back End Interface * Writing New Back Ends:: Extending old back ends. * Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end. * Mail-like Back Ends:: Some tips on mail back ends. +* Web Feed Back Ends:: Easily defining back ends for web feeds. @end menu @@ -30770,6 +30810,43 @@ Mail-like Back Ends @end example +@node Web Feed Back Ends +@subsubsection Web Feed Back Ends + +If you want to write a back end for a new type of web feed (RSS, +Atom), or some other type of feed, an ``abstract'' back end +(@code{nnfeed}) exists to enable the creation of such back ends with +minimal knowledge of Gnus. + +@code{nnfeed} defines a generic parser, which uses functions stored in +server variables to parse information from a feed (@code{nnfeed} +itself doesn't actually define any such functions though). + +The data parsed from the feed is stored in server variables (and +stored per-feed in a sub-directory of @option{gnus-directory} whose name +corresponds to the name of the back end). + +A Gnus back end interface is also defined, which uses the data parsed +from the feed. + +Therefore, a new back end only needs to inherit from @code{nnfeed}, +define (fairly) generic parsing functions for the feed type and setup +the required server variables. + +@code{nnfeed} was originally created to support Atom Syndication +Format feeds (@pxref{Atom}), but is very generic (as of writing this, +no standard web feed exists which can meaningfully use all the +features supported): it supports multiple groups contained in a single +feed, it allows for situations when the entire feed can't (or +shouldn't) be read ahead of time and it allows for very advanced +customization of the actual printing of articles from parsed data +(while providing a reasonably powerful default method). + +Further implementation details are available in the documentation +strings of the various @code{nnfeed-*} server variables and +the commentary and other comments of @file{nnfeed.el}. + + @node Score File Syntax @subsection Score File Syntax diff --git a/etc/NEWS b/etc/NEWS index 82c73f7416b..fea27bb8a31 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1337,6 +1337,16 @@ when using the ':vc' keyword. ** Gnus ++++ +*** New back end 'nnfeed'. +This allows back end developers to easily create new back ends for web +feeds, as inheriting back ends of 'nnfeed'. + ++++ +*** New back end 'nnatom'. +This allow users to add Atom Syndication Format feeds to Gnus as +servers. + *** The 'nnweb-type' option 'gmane' has been removed. The gmane.org website is, sadly, down since a number of years with no prospect of it coming back. Therefore, it is no longer valid to set diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index dab66b60205..bc8819dc967 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -1360,6 +1360,7 @@ gnus-valid-select-methods ("nnimap" post-mail address prompt-address physical-address respool server-marks cloud) ("nnmaildir" mail respool address server-marks) + ("nnatom" address) ("nnnil" none)) "An alist of valid select methods. The first element of each list lists should be a string with the name diff --git a/lisp/gnus/nnatom.el b/lisp/gnus/nnatom.el new file mode 100644 index 00000000000..e8dfa12aff5 --- /dev/null +++ b/lisp/gnus/nnatom.el @@ -0,0 +1,276 @@ +;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. +;; Author: Daniel Semyonov + +;; This file is part of GNU Emacs. + +;; nnatom 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 3 of the License, or +;; (at your option) any later version. + +;; nnatom 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 nnatom. If not, see . + +;;; Commentary: + +;; Gnus backend for HTTP or local feeds following the +;; Atom Syndication Format . + +;;; Code: + +(eval-when-compile + (require 'cl-lib) + (require 'subr-x)) + +(require 'nnfeed) +(require 'mm-url) +(require 'dom) + +(defgroup nnatom nil + "Atom backend for Gnus." + :group 'nnfeed) + +(nnoo-declare nnatom nnfeed) + +(nnfeed-define-basic-backend-interface nnatom) + +;;;; Atom feed parser: + +(defun nnatom--read-feed (feed _) + "Return a list structure representing FEED, or nil." + (if (string-match-p "\\`https?://" feed) + (nnheader-report + nnatom-backend + "Address shouldn't start with \"http://\" or \"https://\"") + (with-temp-buffer + (condition-case e + (if (file-name-absolute-p feed) + (insert-file-contents feed) + (mm-url-insert-file-contents (concat "https://" feed))) + (file-error (nnheader-report nnatom-backend (cdr e))) + (:success (when-let ((data (if (libxml-available-p) + (libxml-parse-xml-region + (point-min) (point-max)) + (car (xml-parse-region + (point-min) (point-max))))) + (authors (list 'authors))) + (when (eq (car data) 'top) + (setq data (assq 'feed data))) + (dom-add-child-before data authors) + (let ((all (dom-children data))) + (while-let ((rest (cdr all)) + (child (car-safe rest)) + (type (car-safe child)) + ((not (eq type 'entry)))) + (and (or (eq type 'author) + (eq type 'contributor)) + (dom-add-child-before authors child)) + (setq all rest)) + ;; Order of entries is reversed as most Atom feeds + ;; list only the "most recent" entries, in reverse + ;; chronological order. + (setcdr all (nreverse (cdr all)))) + data)))))) +(defvoo nnatom-read-feed-function #'nnatom--read-feed + nil nnfeed-read-feed-function) + +(defun nnatom--read-group (data) + "Return the next group and the remaining DATA in a cons cell, or nil." + `(,data)) +(defvoo nnatom-read-group-function #'nnatom--read-group + nil nnfeed-read-group-function) + +(defun nnatom--read-article (data _) + "Return the next article and the remaining DATA in a cons cell, or nil." + (when (eq (car data) 'feed) (setq data (dom-children data))) + ;; Discard any children between/after entries. + (while (and data (not (eq (car-safe (car data)) 'entry))) (pop data)) + (when-let ((article (car data)) + (auths (list 'authors)) (links (list 'links))) + (dom-add-child-before article links) + (dom-add-child-before article auths) + (dolist (child (cddddr article) `(,article . ,(cdr data))) + (pcase (car-safe child) ; Authors and links can appear + ((or 'author 'contributor) ; anywhere in the entry so we + (dom-add-child-before auths child) ; collect them all here to + (dom-add-child-before links child)) ; avoid looping over the + ((or 'link ; entry multiple times later. + (and 'content (guard (assq 'src (dom-attributes child))))) + (dom-add-child-before links child)))))) +(defvoo nnatom-read-article-function #'nnatom--read-article + nil nnfeed-read-article-function) + +(defun nnatom--read-title (group) + "Return the title of GROUP, or nil." + (dom-text (dom-child-by-tag group 'title))) +(defvoo nnatom-read-title-function #'nnatom--read-title + nil nnfeed-read-title-function) + +(defun nnatom--read-description (group) + "Return the description of GROUP, or nil." + (dom-text (dom-child-by-tag group 'subtitle))) +(defvoo nnatom-read-description-function #'nnatom--read-description + nil nnfeed-read-description-function) + +(defun nnatom--read-article-or-group-authors (article-or-group) + "Return the authors of ARTICLE-OR-GROUP, or nil." + (when-let + ((a (mapconcat + (lambda (author) + (let* ((name (dom-text (dom-child-by-tag author 'name))) + (name (unless (string-blank-p name) name)) + (email (dom-text (dom-child-by-tag author 'email))) + (email (unless (string-blank-p email) email))) + (or (and name email (format "%s <%s>" name email)) name email))) + (dom-children (dom-child-by-tag article-or-group 'authors)) + ", ")) + ((not (string-blank-p a)))) + a)) +(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-authors + nil nnfeed-read-author-function) +(defvoo nnatom-read-group-author-function + #'nnatom--read-article-or-group-authors + nil nnfeed-read-group-author-function) + +(defun nnatom--read-subject (article) + "Return the subject of ARTICLE, or nil." + (dom-text (dom-child-by-tag article 'title))) +(defvoo nnatom-read-subject-function #'nnatom--read-subject + nil nnfeed-read-subject-function) + +(defun nnatom--read-id (article) + "Return the ID of ARTICLE. +If the ARTICLE doesn't contain an ID but it does contain a subject, +return the subject. Otherwise, return nil." + (or (dom-text (dom-child-by-tag article 'id)) + (nnatom--read-subject article))) +(defvoo nnatom-read-id-function #'nnatom--read-id + nil nnfeed-read-id-function) + +(defun nnatom--read-publish (article) + "Return the date and time ARTICLE was published, or nil." + (when-let (d (dom-child-by-tag article 'published)) + (date-to-time (dom-text d)))) +(defvoo nnatom-read-publish-date-function #'nnatom--read-publish + nil nnfeed-read-publish-date-function) + +(defun nnatom--read-update (article) + "Return the date and time of the last update to ARTICLE, or nil." + (when-let (d (dom-child-by-tag article 'updated)) + (date-to-time (dom-text d)))) +(defvoo nnatom-read-update-date-function #'nnatom--read-update + nil nnfeed-read-update-date-function) + +(defun nnatom--read-links (article) + "Return all links contained in ARTICLE, or nil." + (let ((alt 0) (rel 0) (sel 0) (enc 0) (via 0) (aut 0)) + (mapcan + (lambda (link) + (when-let ((l (car-safe link))) + (or + (when-let (((eq l 'content)) + (src (dom-attr link 'src)) + (label (concat "Link" + (and (< 1 (cl-incf alt)) + (format " %s" alt))))) + `(((("text/plain") . ,(format "%s: %s\n" label src)) + (("text/html") . ,(format "[%s] " + src label))))) + (when-let (((or (eq l 'author) (eq l 'contributor))) + (name (dom-text (dom-child-by-tag link 'name))) + (name (if (string-blank-p name) + (concat "Author" + (and (< 1 (cl-incf aut)) + (format " %s" aut))) + name)) + (uri (dom-text (dom-child-by-tag link 'uri))) + ((not (string-blank-p uri)))) + `(((("text/plain") . ,(format "%s: %s\n" name uri)) + (("text/html") . ,(format "[%s] " + uri name))))) + (when-let (((eq l 'link)) + (attrs (dom-attributes link)) + (label (or (cdr (assq 'title attrs)) + (pcase (cdr (assq 'rel attrs)) + ("related" + (concat "Related" + (and (< 1 (cl-incf rel)) + (format " %s" rel)))) + ("self" + (concat "More" + (and (< 1 (cl-incf sel)) + (format " %s" sel)))) + ("enclosure" + (concat "Enclosure" + (and (< 1 (cl-incf enc)) + (format " %s" enc)))) + ("via" + (concat "Source" + (and (< 1 (cl-incf via)) + (format " %s" via)))) + (_ (if-let + ((lang (cdr (assq 'hreflang link)))) + (format "Link (%s)" lang) + (concat + "Link" + (and (< 1 (cl-incf alt)) + (format " %s" alt)))))))) + (link (cdr (assq 'href attrs)))) + `(((("text/plain") . ,(format "%s: %s\n" label link)) + (("text/html") . ,(format "[%s] " + link label)))))))) + (dom-children (dom-child-by-tag article 'links))))) +(defvoo nnatom-read-links-function #'nnatom--read-links + nil nnfeed-read-links-function) + +(defun nnatom--read-part (part type) + (let* ((atypes '("html" "plain")) + (mtypes '(("xhtml" . "text/html") ("text" . "text/plain"))) + (xsuff (concat "[+/]xml\\(-\\(dtd\\|external-parsed-entity\\)\\)?\\'" + "\\|^text")) + (part (if (string= type "xhtml") + (with-temp-buffer + (dom-print (dom-child-by-tag part 'div) nil t) + (buffer-substring-no-properties + (point-min) (point-max))) + (dom-text part))) + (type (if (member type atypes) (concat "text/" type) type)) + (type (or (cdr (assoc type mtypes)) type))) + (unless (string-blank-p part) + `(,part (Content-Type . ,(or type (setq type "text/plain"))) + ,(and (not (string-match-p xsuff type)) + '(Content-Transfer-Encoding . "base64")))))) + +(defun nnatom--read-parts (article) + "Return all parts contained in ARTICLE, or an empty HTML part with links." + (let* ((summary (dom-child-by-tag article 'summary)) + (stype (cdr (assq 'type (dom-attributes summary)))) + (summary (nnatom--read-part summary stype)) + (content (dom-child-by-tag article 'content)) + (ctype (cdr (assq 'type (dom-attributes content)))) + (content (nnatom--read-part content ctype)) + (st (string= stype ctype)) + parts) + (cond ((and summary content) + (and st (push summary parts)) + (push (append content '(links)) parts) + (or st (push summary parts))) + ((setq content (or summary content)) + (push (append content '(links)) parts)) + (t (push '((nil (Content-Type . "text/html") links)) parts))) + parts)) +(defvoo nnatom-read-parts-function #'nnatom--read-parts + nil nnfeed-read-parts-function) + +(gnus-declare-backend (symbol-name nnatom-backend) 'address) + +(provide 'nnatom) + +;;; nnatom.el ends here diff --git a/lisp/gnus/nnfeed.el b/lisp/gnus/nnfeed.el new file mode 100644 index 00000000000..0bf599553e4 --- /dev/null +++ b/lisp/gnus/nnfeed.el @@ -0,0 +1,683 @@ +;;; nnfeed.el --- Generic feed backend for Gnus -*- lexical-binding: t -*- + +;; Copyright (C) 2023 Free Software Foundation, Inc. +;; Author: Daniel Semyonov + +;; This file is part of GNU Emacs. + +;; nnfeed 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 3 of the License, or +;; (at your option) any later version. + +;; nnfeed 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 nnfeed. If not, see . + +;;; Commentary: + +;; Generic Gnus backend (intended) for implementing backends for web +;; feeds (Atom, RSS). +;; +;; This backend is abstract - it doesn't implement a parser for any +;; specific web feed type, and so can't be used independently. +;; +;; Instead, it implements a generic parser, feed data storage and most +;; of the Gnus backend interface; the intended use for this backend is +;; to be a source of inheritance for backends supporting new web feed +;; types. +;; +;; To implement new backends, use `nnfeed-define-basic-backend-interface': +;; +;; ... +;; (require 'nnfeed) +;; +;; (nnoo-declare nnfoo nnfeed) +;; +;; (nnfeed-define-basic-backend-interface nnfoo) +;; ... +;; [ definitions of parsing functions, see the "Feed parser interface" +;; section for more information. ] +;; +;; (defvoo nnfoo-read-feed-function #'nnfoo--read-feed +;; nil nnfeed-read-feed-function) +;; ... +;; (gnus-declare-backend (symbol-name nnfeed-backend) 'address) +;; +;; (provide 'nnfoo) +;; +;;; Code: + +(eval-when-compile + (require 'subr-x)) + +(require 'gnus) +(require 'nnoo) + +(defgroup nnfeed nil + "Generic feed backend for Gnus." + :group 'gnus) + +(defcustom nnfeed-date-format "%F %X%p" + "Format of displayed dates (see function `format-time-string')." + :type 'string) + +(nnoo-declare nnfeed) + +(defvoo nnfeed-backend nil + "Symbol which identifies this backend.") + +(defvoo nnfeed-status-string nil + "Last status message reported by this backend.") + +;; This macro should be used to define inheriting backends. + +(defmacro nnfeed-define-basic-backend-interface (backend) + "Define a basic set of functions and variables for BACKEND." + `(progn + (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnfeed-backend) + (defvoo ,(nnoo-symbol backend 'status-string) + nil nil nnfeed-status-string) + (defvoo ,(nnoo-symbol backend 'group) nil nil nnfeed-group) + (defvoo ,(nnoo-symbol backend 'servers) + (make-hash-table :test 'equal) nil nnfeed-servers) + (defvoo ,(nnoo-symbol backend 'group-article-ids) + (make-hash-table :test 'equal) nil nnfeed-group-article-ids) + (defvoo ,(nnoo-symbol backend 'group-articles) + (make-hash-table :test 'eql) nil nnfeed-group-articles) + (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil + nnfeed-group-article-max-num) + (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil + nnfeed-group-article-min-num) + ,@(mapcar (lambda (fun) + `(deffoo ,(nnoo-symbol backend fun) (&optional server) + (,(nnoo-symbol 'nnoo fun) ',backend server))) + '(server-opened status-message)) + (deffoo ,(nnoo-symbol backend 'open-server) (server &optional defs) + (nnfeed-open-server server defs ',backend)) + (nnoo-import ,backend (nnfeed)))) + +;;;; Feed parser interface: + +;; The following set of server variables define a parser for a +;; specific web feed type. +;; An inheriting backend doesn't necessarily have to define all of +;; these functions (see the comments below for more information). +;; Apart from this set of variables there is also +;; `nnfeed-print-content-function' which can optionally be defined +;; by an inheriting backend to allow more advanced control over the +;; printing of articles. + +(defvoo nnfeed-read-feed-function #'ignore + "Function returning a Lisp object representing a feed (or part of it). + +It should accept two arguments, the address of a feed and the name of +a group (or nil). +If a group name is supplied, it should return a representation of only +the group (as if it was extracted from the feed with +`nnfeed-read-group-function').") + +(defvoo nnfeed-read-group-function #'ignore + "Function returning a cons cell of a group and remaining data from a feed. + +The returned group can be represented by any Lisp object. +It should accept a single argument, a Lisp object representing a feed +\(as can be returned by this function or `nnfeed-read-feed-function').") + +(defvoo nnfeed-read-article-function #'ignore + "Function returning a cons cell of an article and remaining data from a group. + +The returned article can be represented by any Lisp object. +It should accept two arguments, a Lisp object representing a group +\(as can be returned by this function or `nnfeed-read-group-function'), +and a flag indicating whether the last article was not new or updated.") + +(defvoo nnfeed-read-title-function #'ignore + "Function returning the title of a group (a string). + +It should accept a single argument, a Lisp object representing a group +\(as returned by `nnfeed-read-group-function').") + +;; Optional. +(defvoo nnfeed-read-description-function #'ignore + "Function returning the description of a group (a string), or nil. + +It should accept a single argument, a Lisp object representing a group +\(as returned by `nnfeed-read-group-function').") + +;; Either this function or `nnfeed-read-author-function' is required. +(defvoo nnfeed-read-group-author-function #'ignore + "Function returning the author of a group (a string), or nil. + +It should accept a single argument, a Lisp object representing a group +\(as returned by `nnfeed-read-group-function')..") + +(defvoo nnfeed-read-id-function #'ignore + "Function returning the ID of an article. + +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +(defvoo nnfeed-read-subject-function #'ignore + "Function returning the subject of an article (a string), or nil. + +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +;; Either this function or `nnfeed-read-update-date-function' is required. +(defvoo nnfeed-read-publish-date-function #'ignore + "Function returning the publish date of an article (a time value), or nil. + +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +;; Either this function or `nnfeed-read-publish-date-function' is required. +(defvoo nnfeed-read-update-date-function #'ignore + "Function returning the update date of an article (a time value), or nil. + +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +;; Either this function or `nnfeed-read-group-author-function' is required. +(defvoo nnfeed-read-author-function #'ignore + "Function returning the author of an article (a string), or nil. + +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +(defvoo nnfeed-read-headers-function #'ignore + "Function returning an alist of article-wide MIME headers. + +Each element of this alist maps a MIME header (a symbol, +i.e. `Content-Type') to its value. As a special case, `:boundary' +maps to a string which will serve as the boundary between article +parts. This must be supplied if a custom boundary is used in a +multipart content type header. The default boundary is \"-_nnfeed_-\", +and is automatically modified to match the name of the back end. +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +;; As mentioned in their docstrings, the last two parsing functions +;; can optionally return any Lisp representation they want, provided +;; an appropriate `nnfeed-print-content-function' is defined. This +;; means they are also not _strictly_ required. + +(defvoo nnfeed-read-links-function #'ignore + "Function returning all links contained in an article. + +With the default `nnfeed-print-content-function', it should return a +list of links, where each link is an alist mapping MIME content types +to links formatted for display in a part of that type. Each content +type may also be a list of content types. +Otherwise, it could return any Lisp object. +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +(defvoo nnfeed-read-parts-function #'ignore + "Function returning an alist associating parts of an article to their headers. + +With the default `nnfeed-print-content-function', each part should be a +string. Otherwise, it can be any Lisp object. The \"headers\" of +each part should be a list where each element is either a cons of a +MIME header (a symbol, i.e. `Content-Type') and its value (a string), +or any other Lisp object. MIME headers will be printed, the rest will +be passed on to `nnfeed-print-content-function', which recognizes the +following extra data by default: +- `links', if present, will cause links to be printed in the part. +It should accept a single argument, a Lisp object representing an article +\(as returned by `nnfeed-read-article-function').") + +;;;; Feed data storage: + +;; This section defines the data types used to store feed data, and +;; functions to read and write it. +;; All variables in this section are automatically defined by +;; `nnfeed-define-basic-backend-interface'. + +(defvoo nnfeed-servers (make-hash-table :test 'equal) + "Hash table mapping known servers to their groups. + +Each value in this table should itself be a hash table mapping known +group names to their data, which should be a vector of the form +[GROUP IDS ARTICLES MAX MIN DESCRIPTION], where: +- GROUP is the \"real\" group name (the name known to the server). +- IDS is a hash table mapping article IDs to their numbers. +- ARTICLES is a hash table mapping article numbers to articles and + their attributes (see `nnfeed-group-articles'). +- MAX is the maximum article number. +- MIN is the minimum article number. +- DESCRIPTION is the group description.") + +(defvoo nnfeed-group-names (make-hash-table :test 'equal) + "Hash table mapping real group names to their custom name.") + +(defun nnfeed--server-address (server) + "Return SERVER's real address." + (if (string-suffix-p "-ephemeral" server) + (setq server (or (cadr (assq (nnoo-symbol nnfeed-backend 'address) + (cddr (gnus-server-to-method + (concat + (symbol-name nnfeed-backend) ":" + server))))) + server)) + server)) + +(defun nnfeed--server-file (server) + "Return the file containing data for SERVER." + (expand-file-name (format "%s/%s.eld" + (string-trim (symbol-name nnfeed-backend) + "nn") + (gnus-newsgroup-savable-name + (nnfeed--server-address server))) + gnus-directory)) + +(defun nnfeed--read-server (server) + "Read SERVER's information from storage." + (if-let ((f (nnfeed--server-file server)) + ((file-readable-p f))) + (with-temp-buffer + (insert-file-contents f) + (goto-char (point-min)) + (puthash server (read (current-buffer)) nnfeed-servers)) + (nnheader-report nnfeed-backend "Can't read %s" server))) + +(defun nnfeed--write-server (server) + "Write SERVER's information to storage." + (if-let ((f (nnfeed--server-file server)) + ((file-writable-p f))) + (if-let ((s (gethash server nnfeed-servers)) + ((hash-table-p s))) + (with-temp-file f + (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n") + (prin1 s (current-buffer)) + (insert "\n") + t) + t) + (nnheader-report nnfeed-backend "Can't write %s" f))) + +;; The following function uses the parsing functions defined in the last +;; section to parse a feed (or just one group from it). +;; This is the only place where these parsing functions are used; the Gnus +;; backend interface extracts all required information from the parsed feed. + +(defun nnfeed--parse-feed (feed &optional group) + "Parse GROUP from FEED into a new or existing server. +If GROUP is omitted or nil, parse the entire FEED." + (let* ((feed (nnfeed--server-address feed)) + (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed) + (make-hash-table :test 'equal))) + (name group) ; (Maybe) fake name (or nil) + (group (aref (gethash group s `[,group]) 0)) ; Real name (or nil) + data) + (when (setq data (funcall nnfeed-read-feed-function feed group)) + (while-let ((cg (or (and name (cons data)) ; `data' is a single group + (funcall nnfeed-read-group-function data))) + (cg (prog1 (car cg) (setq data (cdr cg))))) + (let* ((name (funcall nnfeed-read-title-function cg)) ; Real name + (group (gethash name nnfeed-group-names name)) ; (Maybe) fake name + (info (gnus-get-info + (concat (symbol-name nnfeed-backend) "+" feed ":" group))) + (g (or (gethash group s) + `[ ,name ,(make-hash-table :test 'equal) + ,(make-hash-table :test 'eql) nil 1 ""])) + (desc (funcall nnfeed-read-description-function cg)) + (ids (aref g 1)) + (articles (aref g 2)) + (max (aref g 3)) + (max (if max max + (setq max 0) ; Find max article number + (dolist ; remembered by Gnus. + ( r (cons (gnus-info-read info) + (gnus-info-marks info)) + max) + (mapc (lambda (x) + (let ((x (if (consp x) + (if (< (car x) (cdr x)) + (cdr x) (car x)) + x))) + (when (< max x) (setq max x)))) + (if (symbolp (car r)) (cdr r) r))))) + (group-author (funcall nnfeed-read-group-author-function cg)) + stale) + (and desc (aset g 5 desc)) + (while-let ((article (funcall nnfeed-read-article-function cg stale)) + (article (prog1 (car article) (setq cg (cdr article))))) + (when-let ((id (funcall nnfeed-read-id-function article)) + (id (format "<%s@%s.%s>" id name nnfeed-backend))) + (let* ((num (gethash id ids)) + (update (funcall nnfeed-read-update-date-function article)) + (prev-update (aref (gethash num articles + '[nil nil nil nil nil]) + 4))) + (if (or (null num) ; New article ID. + (and (null prev-update) update) + (and prev-update update + (time-less-p prev-update update))) + (let* ((num (or num (aset g 3 (setq max (1+ max))))) + (publish (funcall nnfeed-read-publish-date-function + article))) + (setf + (gethash id (aref g 1)) num + (gethash num (aref g 2)) + `[ ,id + ,(or (funcall nnfeed-read-author-function article) + group-author group) + ,(or (funcall nnfeed-read-subject-function article) + "no subject") + ,(or publish update '(0 0)) ; published + ,(or update publish '(0 0)) ; updated + ,(funcall nnfeed-read-links-function article) + ,(funcall nnfeed-read-parts-function article) + ,(funcall nnfeed-read-headers-function article)] + stale nil)) + (setq stale t))))) + (puthash group g s))) + (puthash feed s nnfeed-servers)))) + +;;;; Gnus backend functions: + +;; The following two sections define a Gnus backend interface based on +;; the parsed data from the last section. +;; All server variables in this section are automatically defined by +;; `nnfeed-define-basic-backend-interface'. +;; For more information about these functions see the "Back End +;; Interface" section of the Gnus manual. + +(defvoo nnfeed-group nil + "Name of the current group.") + +(defvoo nnfeed-group-article-ids (make-hash-table :test 'equal) + "Hash table mapping article IDs to their article number.") + +(defvoo nnfeed-group-articles (make-hash-table :test 'eql) + "Hash table mapping article numbers to articles and their attributes. + +Each value in this table should be a vector of the form +[ID FROM SUBJECT DATE UPDATED LINKS PARTS HEADERS], where: +- ID is the ID of the article. +- FROM is the author of the article or group. +- SUBJECT is the subject of the article. +- DATE is the date the article was published, or last updated (time value). +- UPDATE is the date the article was last updated, or published (time value). +- LINKS is a collection of links (any Lisp object). +- PARTS is an alist associating the content of each part of the + article to its headers. +- HEADERS is an alist associating article-wide MIME headers to their value.") + +(defvoo nnfeed-group-article-max-num 0 + "Maximum article number for the current group.") + +(defvoo nnfeed-group-article-min-num 1 + "Minimum article number for the current group.") + +(nnoo-define-basics nnfeed) + +(defun nnfeed--current-server-no-prefix () + "Remove the \"+\" prefix from the current server." + (string-remove-prefix (concat (symbol-name nnfeed-backend) "+") + (nnoo-current-server nnfeed-backend))) + +(defun nnfeed--group-data (group server) + "Get parsed data for GROUP from SERVER." + (when-let ((server (nnfeed--server-address server)) + (s (gethash server nnfeed-servers)) + ((hash-table-p s))) + (gethash group s))) + +(defun nnfeed-retrieve-article (article group) + "Retrieve headers for ARTICLE from GROUP." + (if-let ((a (gethash article (aref group 2)))) + (insert (format "221 %s Article retrieved. +From: %s\nSubject: %s\nDate: %s\nMessage-ID: %s\n.\n" + article + (aref a 1) + (aref a 2) + (format-time-string "%F %H:%M" (aref a 3)) + (aref a 0))) + (insert "404 Article not found.\n.\n"))) + +(deffoo nnfeed-retrieve-headers (articles &optional group server _fetch-old) + (if-let ((server (or server (nnfeed--current-server-no-prefix))) + (g (or (nnfeed--group-data group server) + `[ nil ,nnfeed-group-article-ids ,nnfeed-group-articles + nil nil nil]))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (or (and (stringp (car articles)) + (mapc (lambda (a) + (nnfeed-retrieve-article + (gethash a (aref g 2)) g)) + articles)) + (and (numberp (car articles)) + (range-map (lambda (a) (nnfeed-retrieve-article a g)) + articles))) + 'headers) + (nnheader-report nnfeed-backend "Group %s not found" (or group "")))) + +(deffoo nnfeed-open-server (server &optional defs backend) + (let ((backend (or backend 'nnfeed)) + (a (nnfeed--server-address server)) + s) + (nnoo-change-server backend server defs) + (when (setq s (or (gethash a nnfeed-servers) (nnfeed--read-server server))) + (maphash (lambda (group g) + (setq g (aref g 0)) + (unless (string= group g) + (puthash g group nnfeed-group-names))) + s)) + (setq a (nnfeed--server-file server)) + (or s (condition-case _ (make-directory (file-name-parent-directory a) t) + (:success (file-writable-p a)) + (t nil)) + (and (nnoo-close-server nnfeed-backend server) + (nnheader-report + nnfeed-backend "Server file %s not readable or writable" + server))))) + +(deffoo nnfeed-request-close () + (when (hash-table-p nnfeed-servers) + (maphash (lambda (server _) (nnfeed--write-server server)) nnfeed-servers) + (setq nnfeed-servers (make-hash-table :test 'equal))) + (setq nnfeed-status-string nil) + t) + +;; The default content printing function, which should be suitable for +;; most inheriting backends. + +(defun nnfeed--print-content (content attributes links) + "Return CONTENT formatted according to ATTRIBUTES, with LINKS possibly added." + (let ((links (and (memq 'links attributes) links))) + (when (or content links) + (concat + (and content (format "%s\n\n" content)) + (mapconcat (lambda (link) + (cdr (assoc (cdr (assq 'Content-Type attributes)) link + (lambda (types type) + (if (stringp types) (string= types type) + (member type types)))))) + links))))) + +(defvoo nnfeed-print-content-function #'nnfeed--print-content + "Function returning a single piece of content for an article (a string). + +It should accept three arguments, a part and its attributes (as returned +by `nnfeed-read-parts-function'), and links (as returned by +`nnfeed-read-links-function').") + +(defun nnfeed--print-part (content headers mime links) + "Print part of an article using its CONTENT, HEADERS, and LINKS. +Only HEADERS of a type included in MIME are considered." + (concat + (mapconcat (lambda (header) + (when-let ((m (car-safe header)) + ((member m mime))) + (format "%s: %s\n" m (cdr header)))) + headers) + "\n" + (funcall nnfeed-print-content-function content headers links))) + +(deffoo nnfeed-request-article (article &optional group server to-buffer) + (if-let ((server (or server (nnfeed--current-server-no-prefix))) + (g (or (nnfeed--group-data group server) + (and (setq group nnfeed-group) + `[ nil ,nnfeed-group-article-ids + ,nnfeed-group-articles + ,nnfeed-group-article-max-num + ,nnfeed-group-article-min-num nil]))) + (num (or (and (stringp article) + (gethash article (aref g 1))) + (and (numberp article) article))) + ((and (<= num (aref g 3)) + (>= num (aref g 4)))) + (a (gethash num (aref g 2)))) + (with-current-buffer (or to-buffer nntp-server-buffer) + (erase-buffer) + (let* ((links (aref a 5)) + (parts (aref a 6)) + (headers (aref a 7)) + (boundary (or (cdr (assq :boundary headers)) + (format "-_%s_-" nnfeed-backend))) + (multi (length> parts 1)) + (mime '( Content-Type Content-Disposition + Content-Transfer-Encoding))) + (insert (format + "Subject: %s\nFrom: %s\nDate: %s\nMessage-ID: %s\n" + (aref a 2) (aref a 1) + (format-time-string + nnfeed-date-format (or (aref a 3) '(0 0))) + (aref a 0)) + (if (assq 'MIME-Version headers) "" "MIME-Version: 1.0\n") + (mapconcat (lambda (header) + (unless (keywordp (car header)) + (format "%s: %s\n" (car header) (cdr header)))) + headers) + (if multi + (if (assq 'Content-Type headers) "" + (format + "Content-Type: multipart/alternative; boundary=%s\n" + boundary)) + (prog1 (nnfeed--print-part + (caar parts) (cdar parts) mime links) + (setq parts nil))) + (mapconcat (lambda (part) + (format "--%s\n%s\n" boundary + (nnfeed--print-part + (car part) (cdr part) mime links))) + parts) + (if multi (format "--%s--" boundary) "\n"))) + `(,group . ,num)) + (nnheader-report nnfeed-backend "No such article"))) + +(deffoo nnfeed-request-group (group &optional server fast _info) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (if-let ((server (or server (nnfeed--current-server-no-prefix))) + (g (or (if fast (nnfeed--group-data group server) + (setq server (nnfeed--parse-feed server group)) + (and (hash-table-p server) (gethash group server))) + `[ ,group ,(make-hash-table :test 'equal) + ,(make-hash-table :test 'eql) 0 1 ""]))) + (progn + (setq nnfeed-group group + nnfeed-group-article-ids (aref g 1) + nnfeed-group-articles (aref g 2) + nnfeed-group-article-max-num (aref g 3) + nnfeed-group-article-min-num (aref g 4)) + (insert (format "211 %s %s %s \"%s\"" + (hash-table-count nnfeed-group-article-ids) + nnfeed-group-article-min-num + nnfeed-group-article-max-num group)) + t) + (insert "404 group not found") + (nnheader-report nnfeed-backend "Group %s not found" group)))) + +(deffoo nnfeed-close-group (group &optional server) + (and (string= group nnfeed-group) + (setq nnfeed-group nil + nnfeed-group-article-ids (make-hash-table :test 'equal) + nnfeed-group-articles (make-hash-table :test 'eql) + nnfeed-group-article-max-num 0 + nnfeed-group-article-min-num 1)) + (setq server (or server (nnfeed--current-server-no-prefix))) + (nnfeed--write-server server)) + +(deffoo nnfeed-request-list (&optional server) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (when-let ((p (point)) + (s (nnfeed--parse-feed + (or server (nnfeed--current-server-no-prefix)))) + ((hash-table-p s))) + (maphash (lambda (group g) + (insert (format "\"%s\" %s %s y\n" + group (aref g 3) (aref g 4)))) + s) + (not (= (point) p))))) + +(deffoo nnfeed-request-post (&optional _server) + (nnheader-report nnfeed-backend "%s is a read only backend" nnfeed-backend)) + +;;;; Optional back end functions: + +(deffoo nnfeed-retrieve-groups (_groups &optional server) + (nnfeed-request-list server) + 'active) + +(deffoo nnfeed-request-type (_group &optional _article) + 'unknown) + +(deffoo nnfeed-request-group-description (group &optional server) + (when-let ((server (or server (nnfeed--current-server-no-prefix))) + (g (nnfeed--group-data group server))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (insert group " " (aref g 5) "\n")))) + +(deffoo nnfeed-request-list-newsgroups (&optional server) + (when-let ((server (or server (nnfeed--current-server-no-prefix))) + (s (gethash (nnfeed--server-address server) nnfeed-servers)) + ((hash-table-p s))) + (with-current-buffer nntp-server-buffer + (erase-buffer) + (maphash (lambda (group g) + (insert group " " (aref g 5) "\n")) + s)))) + +(deffoo nnfeed-request-rename-group (group new-name &optional server) + (when-let ((server (or server (nnfeed--current-server-no-prefix))) + (a (nnfeed--server-address server)) + (s (or (gethash a nnfeed-servers) + (and ; Open the server to add it to `nnfeed-servers' + (save-match-data + (nnfeed-open-server + server + (cdr ; Get defs and backend. + (assoc a (cdr (assq nnfeed-backend nnoo-state-alist)) + (lambda (car key) + (and (stringp car) + (string-match + (concat + "\\`\\(\\(nn[[:alpha:]]+\\)\\+\\)?" + (regexp-quote key) "\\'") + car) + (setq server car))))) + (if (match-string 1 server) + (intern (match-string 2 server)) 'nnfeed))) + (gethash a nnfeed-servers)))) + (g (or (nnfeed--group-data group a) + `[ ,group ,(make-hash-table :test 'equal) + ,(make-hash-table :test 'eql) nil 1 ""]))) + (puthash new-name g s) + (puthash group new-name nnfeed-group-names) + (remhash group s) + (and (string= group nnfeed-group) + (setq nnfeed-group new-name)) + t)) + +(provide 'nnfeed) + +;;; nnfeed.el ends here -- 2.44.0 --=-=-=--