* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
@ 2023-06-21 7:08 Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
` (5 more replies)
0 siblings, 6 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-06-21 7:08 UTC (permalink / raw)
To: 64202
[-- Attachment #1: Type: text/plain, Size: 596 bytes --]
Tags: patch
This patch adds a back end for Atom feeds to Gnus, and documents it.
In GNU Emacs 30.0.50 (build 3, x86_64-pc-linux-gnu, GTK+ Version
3.24.38, cairo version 1.16.0) of 2023-06-21 built on coldharbour
Repository revision: 0273cb5e6dbd6c5111f3352b7777b4efc769ba14
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12101008
System Description: Void Linux
Configured using:
'configure -C --prefix=/opt/Emacs --with-x --with-x-toolkit=gtk3
--without-gsettings --without-dbus --with-xinput2 --with-small-ja-dic
--with-native-compilation'
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Gnus-Add-back-end-for-Atom-feeds-nnatom.patch --]
[-- Type: text/patch, Size: 35381 bytes --]
From 6085ee8139cc3d815a5028babb4daf438df9d06b Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 42 +++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 705 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 755 insertions(+)
create mode 100644 lisp/gnus/nnatom.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8d25e868c8a..95eba21c4dd 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,46 @@ 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 (@xref{RSS}).
+
+The @code{nnatom} back end allows you to add HTTP or local Atom feeds
+as Gnus servers (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@code{http://} or @code{https://}.
+
+The @code{nnatom} back end saves a server data file in the
+@code{atom} sub-directory of @code{gnus-directory} for each feed.
+
+The @code{nnatom} back end generates an article part for both the
+summary and content of each article in the feed.
+
+@code{nnatom} has been designed to be very modular, and theoretically
+supports many features which aren't available in the Atom Syndication
+Format, in an effort to reduce the work required to build back ends
+for other web feed formats.
+
+Every parsing step is handled by a function stored in a server
+variable; these are all called @code{nnatom-read-*-function}, and
+their requirements are detailed in their docstrings.
+
+The function responsible for printing the content of each article part
+is stored in a server variable (@code{nnatom-print-content-function}).
+The default function only handles (X)HTML and plain text content.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for BACKEND. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index 77ca749ccc3..46e6aeb34dc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -324,6 +324,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** Python Mode
---
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..d35d709c448 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1343,6 +1343,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..3da4644de20
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,705 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>, or any
+;; other type of feed with customized parsing functions.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'gv)
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'gnus)
+
+(nnoo-declare nnatom)
+
+(defvoo nnatom-backend 'nnatom
+ "Symbol which identifies this backend.")
+
+(defvoo nnatom-status-string nil
+ "Last status message reported by this backend.")
+
+(defsubst nnatom--backend-prefix (backend)
+ (concat (symbol-name backend) ":"))
+
+;;;; 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-readable-p feed)
+ (insert-file-contents feed)
+ (mm-url-insert-file-contents (concat "https://" feed)))
+ (file-error (nnheader-report nnatom-backend (cdr e)))
+ (:success (if (libxml-available-p)
+ (libxml-parse-xml-region (point-min) (point-max))
+ (require 'xml)
+ (car (xml-parse-region (point-min) (point-max)))))))))
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+
+(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-by-tag data 'entry)))
+ (and data `(,(car data) . , (setq data (cdr data)))))
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+
+(defun nnatom--read-article-or-group-author (article-or-group)
+ "Return the author of ARTICLE-OR-GROUP, or nil."
+ (let* ((author (dom-child-by-tag article-or-group 'author))
+ (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)))
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+
+(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)))
+
+(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))))
+
+(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))))
+
+(defun nnatom--read-links (article)
+ "Return all links contained in ARTICLE, or nil."
+ (let ((rel (make-vector 5 0))) ; [ALTERNATE RELATED SELF ENCLOSURE VIA]
+ (mapcan
+ (lambda (link)
+ (when-let
+ (((and (consp link) (eq (car link) 'link)))
+ (attrs (dom-attributes link))
+ (label (or (cdr (assq 'title attrs))
+ (pcase (cdr (assq 'rel attrs))
+ ("related"
+ (concat "Related"
+ (and (< 1 (cl-incf (aref rel 1)))
+ (format " %s" (aref rel 1)))))
+ ("self"
+ (concat "More"
+ (and (< 1 (cl-incf (aref rel 2)))
+ (format " %s" (aref rel 2)))))
+ ("enclosure"
+ (concat "Enclosure"
+ (and (< 1 (cl-incf (aref rel 3)))
+ (format " %s" (aref rel 3)))))
+ ("via"
+ (concat "Source"
+ (and (< 1 (cl-incf (aref rel 4)))
+ (format " %s" (aref rel 4)))))
+ (_ (if-let ((lang (cdr (assq 'hreflang link))))
+ (format "Link (%s)" lang)
+ (concat "Link"
+ (and (< 1 (cl-incf (aref rel 0)))
+ (format " %s" (aref rel 0))))))))))
+ `(,(vector (cdr (assq 'href attrs))
+ (concat label ":") (concat "[" label "]")))))
+ article)))
+
+(defsubst nnatom--read-part (part type links)
+ `(,part
+ ("Content-Type" . ,(concat "text/" (or type "plain")))
+ ,(and (or (string= type "html") (string= type "xhtml"))
+ 'html)
+ ,(and links 'links)))
+
+(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 (dom-attr summary 'type))
+ (summary (dom-text summary))
+ (summary (unless (string-blank-p summary) summary))
+ (content (dom-child-by-tag article 'content))
+ (ctype (dom-attr content 'type))
+ (content (dom-text content))
+ (content (unless (string-blank-p content) content))
+ (st (string= stype ctype))
+ parts)
+ (cond ((and summary content)
+ (and st (push (nnatom--read-part summary stype nil) parts))
+ (push (nnatom--read-part content ctype t) parts)
+ (or st (push (nnatom--read-part summary stype nil) parts))
+ parts)
+ ((setq parts (or summary content))
+ `(,(nnatom--read-part parts (if content ctype stype) t)))
+ (t '((nil ("Content-Type" . "text/html") html links))))))
+
+;;;; Feed I/O:
+
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ "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
+`nnatom-read-group-function').")
+
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ "Function returning a cons cell of a group and remaining data from a feed.")
+
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ "Function returning a cons cell of an article and remaining data from a group.
+It should accept a two arguments, a Lisp object representing a feed,
+and a flag indicating whether the last article was stale (not new or updated).")
+
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ "Function returning the title of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ "Function returning the description of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-group-author-function #'nnatom--read-article-or-group-author
+ "Function returning the author of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ "Function returning the ID of an article.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ "Function returning the subject of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ "Function returning the publish date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ "Function returning the update date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-author
+ "Function returning the author of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ "Function returning all links contained in an article.
+For the default `nnatom-print-content-function', it should return a
+list of links, where each link is a vector of the form
+[LINK LABEL HTML-LABEL], where:
+- LINK is the link.
+- LABEL is a label used for LINK (printed \"LABEL: LINK\").
+- HTML-LABEL is a label used for LINK, but only if the type of the
+ part in which LINK is printed is \"html\" or \"xhtml\" (printed \"[LABEL]\").
+Otherwise, it could return any Lisp object.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ "Function returning an alist associating parts of an article to their headers.
+For the default `nnatom-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 string) and its value (a string) or
+any other Lisp object. MIME headers will be printed, the rest will be
+passed on to `nnatom-print-content-function', which recognizes the
+following extra data by default:
+- `links', if present, will cause links to be printed in the part.
+- `html', if present, will format the part as HTML.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-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 `nnatom-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnatom-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnatom--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnatom-backend)
+ "nn")
+ (gnus-newsgroup-savable-name server))
+ gnus-directory))
+
+(defun nnatom--read-server (server)
+ "Read SERVER's information from `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnatom-servers))
+ (nnheader-report nnatom-backend "Can't read %s" server)))
+
+(defun nnatom--write-server (server)
+ "Write SERVER's information to `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnatom-servers))
+ ((hash-table-p s)))
+ (with-temp-file f
+ (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n"
+ (prin1-to-string s))
+ t)
+ t)
+ (nnheader-report nnatom-backend "Can't write %s" f)))
+
+(defsubst nnatom--server-address (server)
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnatom-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat (nnatom--backend-prefix
+ nnatom-backend)
+ server)))))
+ server))
+ server))
+
+(defun nnatom--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnatom--server-address feed))
+ (prefix (nnatom--backend-prefix nnatom-backend))
+ (s (or (gethash feed nnatom-servers)
+ (nnatom--read-server feed) t))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnatom-read-feed-function feed group)
+ s (or (gethash feed nnatom-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (funcall nnatom-read-group-function data)))
+ ((progn (setq data (cdr cg)) t))
+ (cg (car cg)))
+ (let* ((name (funcall nnatom-read-title-function cg)) ; Real name
+ (group (gethash name nnatom-group-names name)) ; (Maybe) fake name
+ (info (gnus-get-info (concat prefix group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnatom-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 nnatom-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnatom-read-article-function cg stale))
+ ((progn (setq cg (cdr article)) t))
+ (article (car article)))
+ (when-let ((id (funcall nnatom-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnatom-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnatom-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 (cl-incf max))))
+ (publish (funcall nnatom-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnatom-read-author-function article)
+ group-author group)
+ ,(or (funcall nnatom-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnatom-read-links-function article)
+ ,(funcall nnatom-read-parts-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnatom-servers))))
+
+;;;; Gnus backend functions:
+
+(defvoo nnatom-group nil
+ "Name of the current group.")
+
+(defvoo nnatom-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnatom-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], 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.")
+
+(defvoo nnatom-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnatom-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(defvar nnatom-date-format "%F %X"
+ "Format of displayed dates.")
+
+(nnoo-define-basics nnatom)
+
+(defun nnatom--group-data (group &optional server)
+ (let ((s (gethash server nnatom-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnoo-current-server nnatom-backend))
+ (setq s (gethash c nnatom-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnatom-servers)))))
+
+(defun nnatom-retrieve-article (article 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 nnatom-date-format (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnatom-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (or (nnatom--group-data group server)
+ `[ nil ,nnatom-group-article-ids ,nnatom-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnatom-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnatom-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnatom-backend "Group %s not found" (or group ""))))
+
+(deffoo nnatom-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnatom))
+ (a (nnatom--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (nnatom--read-server a))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnatom-group-names)))
+ s))
+ (or s (file-writable-p (nnatom--server-file a))
+ (and (nnoo-close-server (or backend 'nnatom) server)
+ (nnheader-report
+ nnatom-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnatom-request-close ()
+ (maphash (lambda (server _)
+ (nnatom--write-server
+ (nnatom--server-address server)))
+ nnatom-servers)
+ (setq nnatom-servers (make-hash-table :test 'equal)
+ nnatom-status-string nil)
+ t)
+
+(defun nnatom--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, possibly with LINKS added."
+ (let ((html (memq 'html attributes))
+ (links (and (memq 'links attributes) links)))
+ (when (or content links)
+ (concat
+ (and html "<html><head></head><body>")
+ (and content (format "%s\n\n" content))
+ (and links html "<p>")
+ (and links
+ (if html
+ (mapconcat
+ (lambda (link)
+ (format "<a href=\"%s\">%s</a>" (aref link 0) (aref link 2)))
+ links " ")
+ (mapconcat
+ (lambda (link)
+ (format "%s %s\n" (aref link 1) (aref link 0)))
+ links "\n")))
+ (and links html "</p>")
+ (and html "</body></html>")))))
+
+(defvoo nnatom-print-content-function #'nnatom--print-content
+ "Function returning a single piece of content (a string).
+It should accept three arguments, a part and its attributes (as returned
+by `nnatom-read-parts-function'), and links.")
+
+(defsubst nnatom--print-part (content headers mime links)
+ (concat
+ (mapconcat (lambda (header)
+ (when-let (((consp header))
+ (m (car header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnatom-print-content-function content headers links)))
+
+(deffoo nnatom-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (or (nnatom--group-data group server)
+ (and (setq group nnatom-group)
+ `[ nil ,nnatom-group-article-ids
+ ,nnatom-group-articles
+ ,nnatom-group-article-max-num
+ ,nnatom-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* ((boundary (format "-_%s_-" nnatom-backend))
+ (links (aref a 5))
+ (parts (aref a 6))
+ (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
+ nnatom-date-format (or (aref a 3) '(0 0)))
+ (aref a 0))
+ "MIME-Version: 1.0\n"
+ (if multi
+ (format
+ "Content-Type: multipart/alternative; boundary=%s\n"
+ boundary)
+ (prog1 (nnatom--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (let ((headers (cdr part)))
+ (format "--%s\n%s\n" boundary
+ (nnatom--print-part
+ (car part) headers mime links))))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnatom-backend "No such article")))
+
+(deffoo nnatom-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (or (if fast (nnatom--group-data group server)
+ (setq server (nnatom--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 nnatom-group group
+ nnatom-group-article-ids (aref g 1)
+ nnatom-group-articles (aref g 2)
+ nnatom-group-article-max-num (aref g 3)
+ nnatom-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnatom-group-article-ids)
+ nnatom-group-article-min-num
+ nnatom-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnatom-backend "Group %s not found" group))))
+
+(deffoo nnatom-close-group (group &optional server)
+ (and (string= group nnatom-group)
+ (setq nnatom-group nil
+ nnatom-group-article-ids (make-hash-table :test 'equal)
+ nnatom-group-articles (make-hash-table :test 'eql)
+ nnatom-group-article-max-num 0
+ nnatom-group-article-min-num 1))
+ (setq server (or server (nnoo-current-server nnatom-backend)))
+ (nnatom--write-server server))
+
+(deffoo nnatom-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnatom--parse-feed
+ (or server (nnoo-current-server nnatom-backend))))
+ ((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 nnatom-request-post (&optional _server)
+ (nnheader-report nnatom-backend "%s is a read only backend" nnatom-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnatom-retrieve-groups (_groups &optional server)
+ (nnatom-request-list (or server (nnoo-current-server nnatom-backend)))
+ 'active)
+
+(deffoo nnatom-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnatom-request-group-description (group &optional server)
+ (when-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (nnatom--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnatom-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (s (gethash server nnatom-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 nnatom-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (s (gethash server nnatom-servers))
+ (g (or (nnatom--group-data group server)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnatom-group-names)
+ (remhash group s)
+ (and (string= group nnatom-group)
+ (setq nnatom-group new-name))
+ t))
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'address)
+
+;;;; Utilities:
+
+(defmacro nnatom-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnatom-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnatom-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnatom-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnatom-servers)
+ (defvoo ,(nnoo-symbol backend 'group-names)
+ (make-hash-table :test 'equal) nil nnatom-group-names)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnatom-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnatom-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnatom-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnatom-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)
+ (nnatom-open-server server defs ',backend))
+ (nnoo-import ,backend (nnatom))))
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-21 7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-06-21 9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 13:02 ` Eli Zaretskii
` (4 subsequent siblings)
5 siblings, 0 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-06-21 9:50 UTC (permalink / raw)
To: 64202
[-- Attachment #1: Type: text/plain, Size: 1883 bytes --]
I realize I never wrote down much about the internals of the back end in
detail, so here are some notes:
- This backend supports all features of Gnus which (I think) make sense.
- It is separated into three main parts - a set of parsing functions
specific to Atom, a fairly generic implementation of server data
storage (since most Atom feeds only contain the few most recent
articles), and a Gnus back end interface which uses the former two
parts to get information for Gnus.
The intention is to allow creating inheriting back ends for different
types of feeds by only changing the first part (and all of its
functions are therefore stored in server variables).
This also means a user can customize the parser by customizing the
select method, which is pretty cool.
- The function responsible for printing the content of each part is also
stored in a server variable ('nnatom-print-content-function).
This means that 'nnatom-read-links-function' can return any Lisp
object and 'nnatom-read-parts-function' can return any Lisp object as
its car and any Lisp object in its cdr (a list) with a custom value of
'nnatom-print-content-function'.
The reason it is customizable is that Atom feeds only support plain
text and (X)HTML feeds, and they already require some extra work to
display nicely; I suspect if other web feed formats support other
types of content they would also require something like that.
And of course it can also be customized through the select method.
- A macro is provided which eliminates most of the boilerplate code
required to define an inheriting back end.
I've also attached a simple inheriting back end for youtube channel
feeds - they are very slightly different from normal Atom feeds so it's
a good way to know whether issues come from the back end itself or from
the inheritance mechanism.
Regards,
Daniel
[-- Attachment #2: nnyt --]
[-- Type: application/emacs-lisp, Size: 1909 bytes --]
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-21 7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-06-21 13:02 ` Eli Zaretskii
2023-06-21 14:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-25 10:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
` (3 subsequent siblings)
5 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2023-06-21 13:02 UTC (permalink / raw)
To: Daniel Semyonov, Andrew Cohen, Eric Abrahamsen, Stefan Monnier,
Lars Ingebrigtsen
Cc: 64202
> Date: Wed, 21 Jun 2023 10:08:51 +0300
> From: Daniel Semyonov via "Bug reports for GNU Emacs,
> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>
> This patch adds a back end for Atom feeds to Gnus, and documents it.
Thanks for working on this.
I don't use Gnus, so my comments will be mostly to the documentation
parts. I expect others (CC'ed) to review the code more thoroughly.
> +Some web sites provide an Atom Syndication Format feed. Atom is a web
> +feed format similar in function to RDF Site Summary (@xref{RSS}).
^^^^^^^^^^
This should be @pxref, not @xref.
> +Note, however, that the server address shouldn't be prefixed with
> +@code{http://} or @code{https://}.
These should use @file, not @code, unless most or all of the rest of
the Gnus manual uses @code for URLs.
> +The @code{nnatom} back end saves a server data file in the
> +@code{atom} sub-directory of @code{gnus-directory} for each feed.
These should definitely be @file, not @code, as these are file names.
> +@defmac nnatom-define-basic-backend-interface backend
> +Define server variables expected by @code{nnatom} and import its back
> +end functions for BACKEND. This macro (or code similar to it) should
^^^^^^^
This should be @var{backend}.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-21 13:02 ` Eli Zaretskii
@ 2023-06-21 14:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 0 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-06-21 14:26 UTC (permalink / raw)
To: Eli Zaretskii
Cc: Andrew Cohen, Eric Abrahamsen, Lars Ingebrigtsen, Stefan Monnier,
64202
[-- Attachment #1: Type: text/plain, Size: 1921 bytes --]
>>>>> Eli Zaretskii writes:
>> Date: Wed, 21 Jun 2023 10:08:51 +0300 From: Daniel Semyonov via
>> "Bug reports for GNU Emacs, the Swiss army knife of text editors"
>> <bug-gnu-emacs@gnu.org>
>>
>> This patch adds a back end for Atom feeds to Gnus, and documents
>> it.
> Thanks for working on this.
> I don't use Gnus, so my comments will be mostly to the
> documentation parts. I expect others (CC'ed) to review the code
> more thoroughly.
Thanks, amended patch attached.
>> +Some web sites provide an Atom Syndication Format feed. Atom is
>> a web +feed format similar in function to RDF Site Summary
>> (@xref{RSS}).
> ^^^^^^^^^^
> This should be @pxref, not @xref.
Fixed.
>> +Note, however, that the server address shouldn't be prefixed
>> with +@code{http://} or @code{https://}.
> These should use @file, not @code, unless most or all of the rest
> of the Gnus manual uses @code for URLs.
I changed it to @url, as the close by RSS node uses it for URL.
Hopefully that's okay.
>> +The @code{nnatom} back end saves a server data file in the
>> +@code{atom} sub-directory of @code{gnus-directory} for each
>> feed.
> These should definitely be @file, not @code, as these are file
> names.
Fixed ('atom' and 'gnus-directory', not 'nnatom' as I think that should
stay @code).
>> +@defmac nnatom-define-basic-backend-interface backend +Define
>> server variables expected by @code{nnatom} and import its back
>> +end functions for BACKEND. This macro (or code similar to it)
>> should
> ^^^^^^^ This should be @var{backend}.
Fixed.
I also attached another back end I made between my last email and now,
for JSON feeds. This is just a POC I made to see how easy it is to
create a "full" derivative back end.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 35381 bytes --]
From 6085ee8139cc3d815a5028babb4daf438df9d06b Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 42 +++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 705 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 755 insertions(+)
create mode 100644 lisp/gnus/nnatom.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8d25e868c8a..95eba21c4dd 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,46 @@ 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 (@xref{RSS}).
+
+The @code{nnatom} back end allows you to add HTTP or local Atom feeds
+as Gnus servers (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@code{http://} or @code{https://}.
+
+The @code{nnatom} back end saves a server data file in the
+@code{atom} sub-directory of @code{gnus-directory} for each feed.
+
+The @code{nnatom} back end generates an article part for both the
+summary and content of each article in the feed.
+
+@code{nnatom} has been designed to be very modular, and theoretically
+supports many features which aren't available in the Atom Syndication
+Format, in an effort to reduce the work required to build back ends
+for other web feed formats.
+
+Every parsing step is handled by a function stored in a server
+variable; these are all called @code{nnatom-read-*-function}, and
+their requirements are detailed in their docstrings.
+
+The function responsible for printing the content of each article part
+is stored in a server variable (@code{nnatom-print-content-function}).
+The default function only handles (X)HTML and plain text content.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for BACKEND. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index 77ca749ccc3..46e6aeb34dc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -324,6 +324,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** Python Mode
---
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..d35d709c448 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1343,6 +1343,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..3da4644de20
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,705 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>, or any
+;; other type of feed with customized parsing functions.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'gv)
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'gnus)
+
+(nnoo-declare nnatom)
+
+(defvoo nnatom-backend 'nnatom
+ "Symbol which identifies this backend.")
+
+(defvoo nnatom-status-string nil
+ "Last status message reported by this backend.")
+
+(defsubst nnatom--backend-prefix (backend)
+ (concat (symbol-name backend) ":"))
+
+;;;; 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-readable-p feed)
+ (insert-file-contents feed)
+ (mm-url-insert-file-contents (concat "https://" feed)))
+ (file-error (nnheader-report nnatom-backend (cdr e)))
+ (:success (if (libxml-available-p)
+ (libxml-parse-xml-region (point-min) (point-max))
+ (require 'xml)
+ (car (xml-parse-region (point-min) (point-max)))))))))
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+
+(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-by-tag data 'entry)))
+ (and data `(,(car data) . , (setq data (cdr data)))))
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+
+(defun nnatom--read-article-or-group-author (article-or-group)
+ "Return the author of ARTICLE-OR-GROUP, or nil."
+ (let* ((author (dom-child-by-tag article-or-group 'author))
+ (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)))
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+
+(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)))
+
+(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))))
+
+(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))))
+
+(defun nnatom--read-links (article)
+ "Return all links contained in ARTICLE, or nil."
+ (let ((rel (make-vector 5 0))) ; [ALTERNATE RELATED SELF ENCLOSURE VIA]
+ (mapcan
+ (lambda (link)
+ (when-let
+ (((and (consp link) (eq (car link) 'link)))
+ (attrs (dom-attributes link))
+ (label (or (cdr (assq 'title attrs))
+ (pcase (cdr (assq 'rel attrs))
+ ("related"
+ (concat "Related"
+ (and (< 1 (cl-incf (aref rel 1)))
+ (format " %s" (aref rel 1)))))
+ ("self"
+ (concat "More"
+ (and (< 1 (cl-incf (aref rel 2)))
+ (format " %s" (aref rel 2)))))
+ ("enclosure"
+ (concat "Enclosure"
+ (and (< 1 (cl-incf (aref rel 3)))
+ (format " %s" (aref rel 3)))))
+ ("via"
+ (concat "Source"
+ (and (< 1 (cl-incf (aref rel 4)))
+ (format " %s" (aref rel 4)))))
+ (_ (if-let ((lang (cdr (assq 'hreflang link))))
+ (format "Link (%s)" lang)
+ (concat "Link"
+ (and (< 1 (cl-incf (aref rel 0)))
+ (format " %s" (aref rel 0))))))))))
+ `(,(vector (cdr (assq 'href attrs))
+ (concat label ":") (concat "[" label "]")))))
+ article)))
+
+(defsubst nnatom--read-part (part type links)
+ `(,part
+ ("Content-Type" . ,(concat "text/" (or type "plain")))
+ ,(and (or (string= type "html") (string= type "xhtml"))
+ 'html)
+ ,(and links 'links)))
+
+(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 (dom-attr summary 'type))
+ (summary (dom-text summary))
+ (summary (unless (string-blank-p summary) summary))
+ (content (dom-child-by-tag article 'content))
+ (ctype (dom-attr content 'type))
+ (content (dom-text content))
+ (content (unless (string-blank-p content) content))
+ (st (string= stype ctype))
+ parts)
+ (cond ((and summary content)
+ (and st (push (nnatom--read-part summary stype nil) parts))
+ (push (nnatom--read-part content ctype t) parts)
+ (or st (push (nnatom--read-part summary stype nil) parts))
+ parts)
+ ((setq parts (or summary content))
+ `(,(nnatom--read-part parts (if content ctype stype) t)))
+ (t '((nil ("Content-Type" . "text/html") html links))))))
+
+;;;; Feed I/O:
+
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ "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
+`nnatom-read-group-function').")
+
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ "Function returning a cons cell of a group and remaining data from a feed.")
+
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ "Function returning a cons cell of an article and remaining data from a group.
+It should accept a two arguments, a Lisp object representing a feed,
+and a flag indicating whether the last article was stale (not new or updated).")
+
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ "Function returning the title of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ "Function returning the description of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-group-author-function #'nnatom--read-article-or-group-author
+ "Function returning the author of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ "Function returning the ID of an article.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ "Function returning the subject of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ "Function returning the publish date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ "Function returning the update date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-author
+ "Function returning the author of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ "Function returning all links contained in an article.
+For the default `nnatom-print-content-function', it should return a
+list of links, where each link is a vector of the form
+[LINK LABEL HTML-LABEL], where:
+- LINK is the link.
+- LABEL is a label used for LINK (printed \"LABEL: LINK\").
+- HTML-LABEL is a label used for LINK, but only if the type of the
+ part in which LINK is printed is \"html\" or \"xhtml\" (printed \"[LABEL]\").
+Otherwise, it could return any Lisp object.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ "Function returning an alist associating parts of an article to their headers.
+For the default `nnatom-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 string) and its value (a string) or
+any other Lisp object. MIME headers will be printed, the rest will be
+passed on to `nnatom-print-content-function', which recognizes the
+following extra data by default:
+- `links', if present, will cause links to be printed in the part.
+- `html', if present, will format the part as HTML.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-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 `nnatom-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnatom-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnatom--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnatom-backend)
+ "nn")
+ (gnus-newsgroup-savable-name server))
+ gnus-directory))
+
+(defun nnatom--read-server (server)
+ "Read SERVER's information from `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnatom-servers))
+ (nnheader-report nnatom-backend "Can't read %s" server)))
+
+(defun nnatom--write-server (server)
+ "Write SERVER's information to `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnatom-servers))
+ ((hash-table-p s)))
+ (with-temp-file f
+ (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n"
+ (prin1-to-string s))
+ t)
+ t)
+ (nnheader-report nnatom-backend "Can't write %s" f)))
+
+(defsubst nnatom--server-address (server)
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnatom-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat (nnatom--backend-prefix
+ nnatom-backend)
+ server)))))
+ server))
+ server))
+
+(defun nnatom--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnatom--server-address feed))
+ (prefix (nnatom--backend-prefix nnatom-backend))
+ (s (or (gethash feed nnatom-servers)
+ (nnatom--read-server feed) t))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnatom-read-feed-function feed group)
+ s (or (gethash feed nnatom-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (funcall nnatom-read-group-function data)))
+ ((progn (setq data (cdr cg)) t))
+ (cg (car cg)))
+ (let* ((name (funcall nnatom-read-title-function cg)) ; Real name
+ (group (gethash name nnatom-group-names name)) ; (Maybe) fake name
+ (info (gnus-get-info (concat prefix group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnatom-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 nnatom-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnatom-read-article-function cg stale))
+ ((progn (setq cg (cdr article)) t))
+ (article (car article)))
+ (when-let ((id (funcall nnatom-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnatom-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnatom-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 (cl-incf max))))
+ (publish (funcall nnatom-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnatom-read-author-function article)
+ group-author group)
+ ,(or (funcall nnatom-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnatom-read-links-function article)
+ ,(funcall nnatom-read-parts-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnatom-servers))))
+
+;;;; Gnus backend functions:
+
+(defvoo nnatom-group nil
+ "Name of the current group.")
+
+(defvoo nnatom-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnatom-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], 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.")
+
+(defvoo nnatom-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnatom-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(defvar nnatom-date-format "%F %X"
+ "Format of displayed dates.")
+
+(nnoo-define-basics nnatom)
+
+(defun nnatom--group-data (group &optional server)
+ (let ((s (gethash server nnatom-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnoo-current-server nnatom-backend))
+ (setq s (gethash c nnatom-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnatom-servers)))))
+
+(defun nnatom-retrieve-article (article 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 nnatom-date-format (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnatom-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (or (nnatom--group-data group server)
+ `[ nil ,nnatom-group-article-ids ,nnatom-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnatom-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnatom-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnatom-backend "Group %s not found" (or group ""))))
+
+(deffoo nnatom-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnatom))
+ (a (nnatom--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (nnatom--read-server a))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnatom-group-names)))
+ s))
+ (or s (file-writable-p (nnatom--server-file a))
+ (and (nnoo-close-server (or backend 'nnatom) server)
+ (nnheader-report
+ nnatom-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnatom-request-close ()
+ (maphash (lambda (server _)
+ (nnatom--write-server
+ (nnatom--server-address server)))
+ nnatom-servers)
+ (setq nnatom-servers (make-hash-table :test 'equal)
+ nnatom-status-string nil)
+ t)
+
+(defun nnatom--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, possibly with LINKS added."
+ (let ((html (memq 'html attributes))
+ (links (and (memq 'links attributes) links)))
+ (when (or content links)
+ (concat
+ (and html "<html><head></head><body>")
+ (and content (format "%s\n\n" content))
+ (and links html "<p>")
+ (and links
+ (if html
+ (mapconcat
+ (lambda (link)
+ (format "<a href=\"%s\">%s</a>" (aref link 0) (aref link 2)))
+ links " ")
+ (mapconcat
+ (lambda (link)
+ (format "%s %s\n" (aref link 1) (aref link 0)))
+ links "\n")))
+ (and links html "</p>")
+ (and html "</body></html>")))))
+
+(defvoo nnatom-print-content-function #'nnatom--print-content
+ "Function returning a single piece of content (a string).
+It should accept three arguments, a part and its attributes (as returned
+by `nnatom-read-parts-function'), and links.")
+
+(defsubst nnatom--print-part (content headers mime links)
+ (concat
+ (mapconcat (lambda (header)
+ (when-let (((consp header))
+ (m (car header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnatom-print-content-function content headers links)))
+
+(deffoo nnatom-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (or (nnatom--group-data group server)
+ (and (setq group nnatom-group)
+ `[ nil ,nnatom-group-article-ids
+ ,nnatom-group-articles
+ ,nnatom-group-article-max-num
+ ,nnatom-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* ((boundary (format "-_%s_-" nnatom-backend))
+ (links (aref a 5))
+ (parts (aref a 6))
+ (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
+ nnatom-date-format (or (aref a 3) '(0 0)))
+ (aref a 0))
+ "MIME-Version: 1.0\n"
+ (if multi
+ (format
+ "Content-Type: multipart/alternative; boundary=%s\n"
+ boundary)
+ (prog1 (nnatom--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (let ((headers (cdr part)))
+ (format "--%s\n%s\n" boundary
+ (nnatom--print-part
+ (car part) headers mime links))))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnatom-backend "No such article")))
+
+(deffoo nnatom-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (or (if fast (nnatom--group-data group server)
+ (setq server (nnatom--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 nnatom-group group
+ nnatom-group-article-ids (aref g 1)
+ nnatom-group-articles (aref g 2)
+ nnatom-group-article-max-num (aref g 3)
+ nnatom-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnatom-group-article-ids)
+ nnatom-group-article-min-num
+ nnatom-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnatom-backend "Group %s not found" group))))
+
+(deffoo nnatom-close-group (group &optional server)
+ (and (string= group nnatom-group)
+ (setq nnatom-group nil
+ nnatom-group-article-ids (make-hash-table :test 'equal)
+ nnatom-group-articles (make-hash-table :test 'eql)
+ nnatom-group-article-max-num 0
+ nnatom-group-article-min-num 1))
+ (setq server (or server (nnoo-current-server nnatom-backend)))
+ (nnatom--write-server server))
+
+(deffoo nnatom-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnatom--parse-feed
+ (or server (nnoo-current-server nnatom-backend))))
+ ((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 nnatom-request-post (&optional _server)
+ (nnheader-report nnatom-backend "%s is a read only backend" nnatom-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnatom-retrieve-groups (_groups &optional server)
+ (nnatom-request-list (or server (nnoo-current-server nnatom-backend)))
+ 'active)
+
+(deffoo nnatom-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnatom-request-group-description (group &optional server)
+ (when-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (g (nnatom--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnatom-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (s (gethash server nnatom-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 nnatom-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnoo-current-server nnatom-backend)))
+ (s (gethash server nnatom-servers))
+ (g (or (nnatom--group-data group server)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnatom-group-names)
+ (remhash group s)
+ (and (string= group nnatom-group)
+ (setq nnatom-group new-name))
+ t))
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'address)
+
+;;;; Utilities:
+
+(defmacro nnatom-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnatom-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnatom-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnatom-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnatom-servers)
+ (defvoo ,(nnoo-symbol backend 'group-names)
+ (make-hash-table :test 'equal) nil nnatom-group-names)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnatom-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnatom-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnatom-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnatom-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)
+ (nnatom-open-server server defs ',backend))
+ (nnoo-import ,backend (nnatom))))
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
--
2.41.0
[-- Attachment #3: nnjsonfeed --]
[-- Type: application/emacs-lisp, Size: 6185 bytes --]
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-21 7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 13:02 ` Eli Zaretskii
@ 2023-06-25 10:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-26 13:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-08 3:31 ` Husain Alshehhi
` (2 subsequent siblings)
5 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-06-25 10:07 UTC (permalink / raw)
To: 64202
[-- Attachment #1: Type: text/plain, Size: 1189 bytes --]
>>>>> Daniel Semyonov writes:
> This patch adds a back end for Atom feeds to Gnus, and
> documents it.
Attached is an updated version of the patch with the following changes:
- Remove "backend+" prefix from server addresses returned by
'nnoo-current-server'.
- Don't handle HTML in any special way when printing content.
- Fix group renaming when the last server of a backend inheriting from
nnatom was of a different backend than the groups'.
- Fix newly parsed feed information being overwritten by old on-disk
information (not sure how I missed this one before).
- Support all content types supported by Atom (I think). Previously I
stated Atom only supports plain text and (X)HTML. This is wrong -
Atom supports arbitrary MIME types too, and thankfully the encoding of
binary data is defined to be base64, which is natively supported by Gnus.
- Change format of stored links - now an alist mapping MIME types (or
lists of them) to a string to print is used.
- Support printing custom article-wide MIME headers.
- Probably some more minor stuff I don't remember.
Also attached is an updated version of the nnyt backend I use for
testing inheritance.
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: nnatom --]
[-- Type: text/x-patch, Size: 39875 bytes --]
From 615d00a9294595574bab4f59df081c39f75724c2 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
Date: Wed, 21 Jun 2023 10:05:04 +0300
Subject: [PATCH 1/2] Gnus: Add back end for Atom feeds (nnatom)
* lisp/gnus/gnus.el (gnus-valid-select-methods): Add entry for nnatom.
* lisp/gnus/nnatom.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 58 ++++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 762 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 828 insertions(+)
create mode 100644 lisp/gnus/nnatom.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8d25e868c8a..9184a4035df 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,62 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 the feed specifies a MIME type),
+even base64 encoded files (like images for example), which are
+supported by Atom.
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@item
+Designed with modularity in mind, the back end theoretically supports
+features which aren't available in Atom (and thus aren't actually
+implemented in practice). For example, the back end operates under
+the assumption that ``servers'' (Atom feeds) can have multiple groups,
+when in reality the parsing functions will only ever return servers
+with a single group. In addition, all parsing steps and some of the
+printing is done in functions stored in server variables, to allow
+very easily defining new back ends for different kinds of feeds by
+inheriting from @code{nnatom}; these are called
+@code{nnatom-read-*-function} and
+@code{nnatom-print-content-function}, and their requirements are
+detailed in their docstrings. A macro is provided to ease creation of
+new inheriting backends.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for @var{backend}. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+@end itemize
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index 77ca749ccc3..46e6aeb34dc 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -324,6 +324,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** Python Mode
---
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..d35d709c448 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1343,6 +1343,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..74ca2a8a5da
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,762 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>, or any
+;; other type of feed with customized parsing functions.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'gv)
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'gnus)
+
+(nnoo-declare nnatom)
+
+(defvoo nnatom-backend 'nnatom
+ "Symbol which identifies this backend.")
+
+(defvoo nnatom-status-string nil
+ "Last status message reported by this backend.")
+
+;;;; 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-readable-p feed)
+ (insert-file-contents feed)
+ (mm-url-insert-file-contents (concat "https://" feed)))
+ (file-error (nnheader-report nnatom-backend (cdr e)))
+ (:success (if (libxml-available-p)
+ (libxml-parse-xml-region (point-min) (point-max))
+ (require 'xml)
+ (car (xml-parse-region (point-min) (point-max)))))))))
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+
+(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-by-tag data 'entry)))
+ (and data `(,(car data) . , (setq data (cdr data)))))
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+
+(defun nnatom--read-article-or-group-author (article-or-group)
+ "Return the author of ARTICLE-OR-GROUP, or nil."
+ (let* ((author (dom-child-by-tag article-or-group 'author))
+ (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)))
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+
+(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)))
+
+(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))))
+
+(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))))
+
+(defun nnatom--read-links (article)
+ "Return all links contained in ARTICLE, or nil."
+ (let ((rel (make-vector 6 0))) ; [ALTERNATE RELATED SELF ENCLOSURE VIA AUTHOR]
+ (mapcan
+ (lambda (link)
+ (when (consp link)
+ (or
+ (when-let (((eq (car link) 'content))
+ (src (dom-attr link 'src))
+ (label (concat "Link"
+ (and (< 1 (cl-incf (aref rel 0)))
+ (format " %s" (aref rel 0))))))
+ `(((("text/plain") . ,(format "%s: %s\n" label src))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ src label)))))
+ (when-let (((eq (car link) 'author))
+ (name (dom-text (dom-child-by-tag link 'name)))
+ (name (if (string-blank-p name)
+ (concat "Author"
+ (and (< 1 (cl-incf (aref rel 5)))
+ (format " %s" (aref rel 5))))
+ 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 "<a href=\"%s\">[%s]</a> "
+ uri name)))))
+ (when-let (((eq (car link) 'link))
+ (attrs (dom-attributes link))
+ (label (or (cdr (assq 'title attrs))
+ (pcase (cdr (assq 'rel attrs))
+ ("related"
+ (concat "Related"
+ (and (< 1 (cl-incf (aref rel 1)))
+ (format " %s" (aref rel 1)))))
+ ("self"
+ (concat "More"
+ (and (< 1 (cl-incf (aref rel 2)))
+ (format " %s" (aref rel 2)))))
+ ("enclosure"
+ (concat "Enclosure"
+ (and (< 1 (cl-incf (aref rel 3)))
+ (format " %s" (aref rel 3)))))
+ ("via"
+ (concat "Source"
+ (and (< 1 (cl-incf (aref rel 4)))
+ (format " %s" (aref rel 4)))))
+ (_ (if-let
+ ((lang (cdr (assq 'hreflang link))))
+ (format "Link (%s)" lang)
+ (concat
+ "Link"
+ (and (< 1 (cl-incf (aref rel 0)))
+ (format " %s" (aref rel 0)))))))))
+ (link (cdr (assq 'href attrs))))
+ `(((("text/plain") . ,(format "%s: %s\n" label link))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ link label))))))))
+ article)))
+
+(defsubst 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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+
+;;;; Feed I/O:
+
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ "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
+`nnatom-read-group-function').")
+
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ "Function returning a cons cell of a group and remaining data from a feed.")
+
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ "Function returning a cons cell of an article and remaining data from a group.
+It should accept a two arguments, a Lisp object representing a feed,
+and a flag indicating whether the last article was stale (not new or updated).")
+
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ "Function returning the title of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ "Function returning the description of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-group-author-function #'nnatom--read-article-or-group-author
+ "Function returning the author of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ "Function returning the ID of an article.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ "Function returning the subject of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ "Function returning the publish date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ "Function returning the update date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-author
+ "Function returning the author of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-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 \"-_nnatom_-\",
+and is automatically modified to match the name of the back end.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ "Function returning all links contained in an article.
+For the default `nnatom-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.")
+
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ "Function returning an alist associating parts of an article to their headers.
+For the default `nnatom-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 `nnatom-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.")
+
+(defvoo nnatom-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 `nnatom-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnatom-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnatom--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnatom-backend)
+ "nn")
+ (gnus-newsgroup-savable-name server))
+ gnus-directory))
+
+(defun nnatom--read-server (server)
+ "Read SERVER's information from `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnatom-servers))
+ (nnheader-report nnatom-backend "Can't read %s" server)))
+
+(defun nnatom--write-server (server)
+ "Write SERVER's information to `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnatom-servers))
+ ((hash-table-p s)))
+ (with-temp-file f
+ (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n"
+ (prin1-to-string s))
+ t)
+ t)
+ (nnheader-report nnatom-backend "Can't write %s" f)))
+
+(defsubst nnatom--server-address (server)
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnatom-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat
+ (symbol-name nnatom-backend) ":"
+ server)))))
+ server))
+ server))
+
+(defun nnatom--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnatom--server-address feed))
+ (s (or (gethash feed nnatom-servers) (nnatom--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnatom-read-feed-function feed group)
+ s (or (gethash feed nnatom-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (funcall nnatom-read-group-function data)))
+ ((progn (setq data (cdr cg)) t))
+ (cg (car cg)))
+ (let* ((name (funcall nnatom-read-title-function cg)) ; Real name
+ (group (gethash name nnatom-group-names name)) ; (Maybe) fake name
+ (info (gnus-get-info
+ (concat (symbol-name nnatom-backend) "+" feed ":" group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnatom-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 nnatom-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnatom-read-article-function cg stale))
+ ((progn (setq cg (cdr article)) t))
+ (article (car article)))
+ (when-let ((id (funcall nnatom-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnatom-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnatom-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 (cl-incf max))))
+ (publish (funcall nnatom-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnatom-read-author-function article)
+ group-author group)
+ ,(or (funcall nnatom-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnatom-read-links-function article)
+ ,(funcall nnatom-read-parts-function article)
+ ,(funcall nnatom-read-headers-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnatom-servers))))
+
+;;;; Gnus backend functions:
+
+(defvoo nnatom-group nil
+ "Name of the current group.")
+
+(defvoo nnatom-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnatom-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 nnatom-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnatom-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(defvar nnatom-date-format "%F %X"
+ "Format of displayed dates.")
+
+(nnoo-define-basics nnatom)
+
+(defsubst nnatom--current-server-no-prefix ()
+ (string-remove-prefix (concat (symbol-name nnatom-backend) "+")
+ (nnoo-current-server nnatom-backend)))
+
+(defun nnatom--group-data (group &optional server)
+ (let ((s (gethash server nnatom-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnatom--current-server-no-prefix))
+ (setq s (gethash c nnatom-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnatom-servers)))))
+
+(defun nnatom-retrieve-article (article 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 nnatom-date-format (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnatom-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ `[ nil ,nnatom-group-article-ids ,nnatom-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnatom-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnatom-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnatom-backend "Group %s not found" (or group ""))))
+
+(deffoo nnatom-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnatom))
+ (a (nnatom--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (or (gethash server nnatom-servers)
+ (nnatom--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnatom-group-names)))
+ s))
+ (or s (file-writable-p (nnatom--server-file a))
+ (and (nnoo-close-server nnatom-backend server)
+ (nnheader-report
+ nnatom-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnatom-request-close ()
+ (maphash (lambda (server _)
+ (nnatom--write-server
+ (nnatom--server-address server)))
+ nnatom-servers)
+ (setq nnatom-servers (make-hash-table :test 'equal)
+ nnatom-status-string nil)
+ t)
+
+(defun nnatom--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, possibly with LINKS 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 nnatom-print-content-function #'nnatom--print-content
+ "Function returning a single piece of content (a string).
+It should accept three arguments, a part and its attributes (as returned
+by `nnatom-read-parts-function'), and links.")
+
+(defsubst nnatom--print-part (content headers mime links)
+ (concat
+ (mapconcat (lambda (header)
+ (when-let (((consp header))
+ (m (car header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnatom-print-content-function content headers links)))
+
+(deffoo nnatom-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ (and (setq group nnatom-group)
+ `[ nil ,nnatom-group-article-ids
+ ,nnatom-group-articles
+ ,nnatom-group-article-max-num
+ ,nnatom-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_-" nnatom-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
+ nnatom-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 (nnatom--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (format "--%s\n%s\n" boundary
+ (nnatom--print-part
+ (car part) (cdr part) mime links)))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnatom-backend "No such article")))
+
+(deffoo nnatom-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (if fast (nnatom--group-data group server)
+ (setq server (nnatom--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 nnatom-group group
+ nnatom-group-article-ids (aref g 1)
+ nnatom-group-articles (aref g 2)
+ nnatom-group-article-max-num (aref g 3)
+ nnatom-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnatom-group-article-ids)
+ nnatom-group-article-min-num
+ nnatom-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnatom-backend "Group %s not found" group))))
+
+(deffoo nnatom-close-group (group &optional server)
+ (and (string= group nnatom-group)
+ (setq nnatom-group nil
+ nnatom-group-article-ids (make-hash-table :test 'equal)
+ nnatom-group-articles (make-hash-table :test 'eql)
+ nnatom-group-article-max-num 0
+ nnatom-group-article-min-num 1))
+ (setq server (or server (nnatom--current-server-no-prefix)))
+ (nnatom--write-server server))
+
+(deffoo nnatom-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnatom--parse-feed
+ (or server (nnatom--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 nnatom-request-post (&optional _server)
+ (nnheader-report nnatom-backend "%s is a read only backend" nnatom-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnatom-retrieve-groups (_groups &optional server)
+ (nnatom-request-list (or server (nnatom--current-server-no-prefix)))
+ 'active)
+
+(deffoo nnatom-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnatom-request-group-description (group &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (nnatom--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnatom-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (gethash server nnatom-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 nnatom-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (or (gethash server nnatom-servers)
+ (and ; Open the server to add it to `nnatom-servers'
+ (save-match-data
+ (nnatom-open-server
+ server
+ (cdr ; Get defs and backend.
+ (assoc server (cdr (assq 'nnatom nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnatom)
+ (setq server (match-string 3 server))))
+ (gethash server nnatom-servers)))))
+ (g (or (nnatom--group-data group server)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnatom-group-names)
+ (remhash group s)
+ (and (string= group nnatom-group)
+ (setq nnatom-group new-name))
+ t))
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'address)
+
+;;;; Utilities:
+
+(defmacro nnatom-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnatom-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnatom-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnatom-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnatom-servers)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnatom-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnatom-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnatom-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnatom-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)
+ (nnatom-open-server server defs ',backend))
+ (nnoo-import ,backend (nnatom))))
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
--
2.41.0
[-- Attachment #3: nnyt --]
[-- Type: application/emacs-lisp, Size: 2443 bytes --]
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-25 10:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-06-26 13:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-26 14:52 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-06-26 13:26 UTC (permalink / raw)
To: 64202; +Cc: Andrew Cohen, Eric Abrahamsen, Lars Ingebrigtsen, Stefan Monnier
Attached is an updated version of the patch.
Changes:
- Add support for multiple authors/contributors.
- Change how links are parsed to avoid looping over all items in an
article for both links and authors.
- Optimize the creation of a list of entries from a feed.
I also forgot to mention I expanded the info node in the last update.
At this point, other than optimizations and bug fixes, the backend is
basically complete; it has very good support for the Atom Syndication
Format, and (I think) it should be possible to implement any Gnus
backend as an inheriting backend of it, without changing any backend
interface functions other than possibly 'nnatom-request-type' and
'nnatom-request-rename-group' (a backend like nnimap will need to add
some backend functions though).
The nnyt backend I posted in my last message still works with this
version (although it does some unnecessary work now).
Apologies if you're not interested in this and you're CC'd; I just
copied the CC header from Eli's last message here since I don't really
know who works on Gnus.
Regards,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-26 13:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-06-26 14:52 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-01 8:39 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-06-26 14:52 UTC (permalink / raw)
To: 64202; +Cc: Andrew Cohen, Eric Abrahamsen, Lars Ingebrigtsen, Stefan Monnier
[-- Attachment #1: Type: text/plain, Size: 113 bytes --]
>>>>> Daniel Semyonov writes:
> Attached is an updated version of the patch.
Actually attached this time.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: nnatom --]
[-- Type: text/x-patch, Size: 41780 bytes --]
From d6c176915f52b3a73b1210740d2f06f91a0b76cb Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 58 ++++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 795 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 861 insertions(+)
create mode 100644 lisp/gnus/nnatom.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8d25e868c8a..9184a4035df 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,62 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 the feed specifies a MIME type),
+even base64 encoded files (like images for example), which are
+supported by Atom.
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@item
+Designed with modularity in mind, the back end theoretically supports
+features which aren't available in Atom (and thus aren't actually
+implemented in practice). For example, the back end operates under
+the assumption that ``servers'' (Atom feeds) can have multiple groups,
+when in reality the parsing functions will only ever return servers
+with a single group. In addition, all parsing steps and some of the
+printing is done in functions stored in server variables, to allow
+very easily defining new back ends for different kinds of feeds by
+inheriting from @code{nnatom}; these are called
+@code{nnatom-read-*-function} and
+@code{nnatom-print-content-function}, and their requirements are
+detailed in their docstrings. A macro is provided to ease creation of
+new inheriting backends.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for @var{backend}. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+@end itemize
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index 3061a147b26..a01177be3d4 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -339,6 +339,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** Python Mode
---
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..d35d709c448 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1343,6 +1343,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..c3756562c23
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,795 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>, or any
+;; other type of feed with customized parsing functions.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'gv)
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'gnus)
+
+(nnoo-declare nnatom)
+
+(defvoo nnatom-backend 'nnatom
+ "Symbol which identifies this backend.")
+
+(defvoo nnatom-status-string nil
+ "Last status message reported by this backend.")
+
+;;;; 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-readable-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)))))
+ (auth (list 'authors)))
+ (dom-add-child-before data auth)
+ (catch :stop ; Collect feed authors, stop at first entry.
+ (dolist (child (cdddr data) data)
+ (let ((tag (car child)))
+ (if (eq tag 'entry)
+ (throw :stop data)
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child))))))))))))
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+
+(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 (cddr data)))
+ (while (and data (not (eq (caar 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 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 avoid
+ (dom-add-child-before links child)) ; looping over the entry multiple
+ ((or 'link ; times later.
+ (and 'content (guard (assq 'src (dom-attributes child)))))
+ (dom-add-child-before links child))))))
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+
+(defun nnatom--read-article-or-group-authors (article-or-group)
+ "Return the authors of ARTICLE-OR-GROUP, or nil."
+ (when-let
+ ((a (string-trim-right
+ (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)))
+ (concat
+ (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))
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+
+(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)))
+
+(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))))
+
+(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))))
+
+(defun nnatom--read-links (article)
+ "Return all links contained in ARTICLE, or nil."
+ (let ((rel (make-vector 6 0))) ; [ALTERNATE RELATED SELF ENCLOSURE VIA AUTHOR]
+ (mapcan
+ (lambda (link)
+ (when-let (((consp link))
+ (l (car link)))
+ (or
+ (when-let (((eq l 'content))
+ (src (dom-attr link 'src))
+ (label (concat "Link"
+ (and (< 1 (cl-incf (aref rel 0)))
+ (format " %s" (aref rel 0))))))
+ `(((("text/plain") . ,(format "%s: %s\n" label src))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ 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 (aref rel 5)))
+ (format " %s" (aref rel 5))))
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 (aref rel 1)))
+ (format " %s" (aref rel 1)))))
+ ("self"
+ (concat "More"
+ (and (< 1 (cl-incf (aref rel 2)))
+ (format " %s" (aref rel 2)))))
+ ("enclosure"
+ (concat "Enclosure"
+ (and (< 1 (cl-incf (aref rel 3)))
+ (format " %s" (aref rel 3)))))
+ ("via"
+ (concat "Source"
+ (and (< 1 (cl-incf (aref rel 4)))
+ (format " %s" (aref rel 4)))))
+ (_ (if-let
+ ((lang (cdr (assq 'hreflang link))))
+ (format "Link (%s)" lang)
+ (concat
+ "Link"
+ (and (< 1 (cl-incf (aref rel 0)))
+ (format " %s" (aref rel 0)))))))))
+ (link (cdr (assq 'href attrs))))
+ `(((("text/plain") . ,(format "%s: %s\n" label link))
+ (("text/html") . ,(format "<a href=\"%s\">[%s]</a> "
+ link label))))))))
+ (dom-children (dom-child-by-tag article 'links)))))
+
+(defsubst 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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+
+;;;; Feed I/O:
+
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ "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
+`nnatom-read-group-function').")
+
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ "Function returning a cons cell of a group and remaining data from a feed.")
+
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ "Function returning a cons cell of an article and remaining data from a group.
+It should accept a two arguments, a Lisp object representing a feed,
+and a flag indicating whether the last article was stale (not new or updated).")
+
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ "Function returning the title of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ "Function returning the description of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-group-author-function
+ #'nnatom--read-article-or-group-authors
+ "Function returning the author of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ "Function returning the ID of an article.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ "Function returning the subject of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ "Function returning the publish date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ "Function returning the update date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-authors
+ "Function returning the author of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-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 \"-_nnatom_-\",
+and is automatically modified to match the name of the back end.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ "Function returning all links contained in an article.
+For the default `nnatom-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.")
+
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ "Function returning an alist associating parts of an article to their headers.
+For the default `nnatom-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 `nnatom-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.")
+
+(defvoo nnatom-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 `nnatom-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnatom-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnatom--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnatom-backend)
+ "nn")
+ (gnus-newsgroup-savable-name server))
+ gnus-directory))
+
+(defun nnatom--read-server (server)
+ "Read SERVER's information from `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnatom-servers))
+ (nnheader-report nnatom-backend "Can't read %s" server)))
+
+(defun nnatom--write-server (server)
+ "Write SERVER's information to `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnatom-servers))
+ ((hash-table-p s)))
+ (with-temp-file f
+ (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n"
+ (prin1-to-string s))
+ t)
+ t)
+ (nnheader-report nnatom-backend "Can't write %s" f)))
+
+(defsubst nnatom--server-address (server)
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnatom-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat
+ (symbol-name nnatom-backend) ":"
+ server)))))
+ server))
+ server))
+
+(defun nnatom--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnatom--server-address feed))
+ (s (or (gethash feed nnatom-servers) (nnatom--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnatom-read-feed-function feed group)
+ s (or (gethash feed nnatom-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (funcall nnatom-read-group-function data)))
+ (cg (prog1 (car cg) (setq data (cdr cg)))))
+ (let* ((name (funcall nnatom-read-title-function cg)) ; Real name
+ (group (gethash name nnatom-group-names name)) ; (Maybe) fake name
+ (info (gnus-get-info
+ (concat (symbol-name nnatom-backend) "+" feed ":" group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnatom-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 nnatom-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnatom-read-article-function cg stale))
+ (article (prog1 (car article) (setq cg (cdr article)))))
+ (when-let ((id (funcall nnatom-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnatom-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnatom-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 (cl-incf max))))
+ (publish (funcall nnatom-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnatom-read-author-function article)
+ group-author group)
+ ,(or (funcall nnatom-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnatom-read-links-function article)
+ ,(funcall nnatom-read-parts-function article)
+ ,(funcall nnatom-read-headers-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnatom-servers))))
+
+;;;; Gnus backend functions:
+
+(defvoo nnatom-group nil
+ "Name of the current group.")
+
+(defvoo nnatom-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnatom-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 nnatom-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnatom-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(defvar nnatom-date-format "%F %X"
+ "Format of displayed dates.")
+
+(nnoo-define-basics nnatom)
+
+(defsubst nnatom--current-server-no-prefix ()
+ (string-remove-prefix (concat (symbol-name nnatom-backend) "+")
+ (nnoo-current-server nnatom-backend)))
+
+(defun nnatom--group-data (group &optional server)
+ (let ((s (gethash server nnatom-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnatom--current-server-no-prefix))
+ (setq s (gethash c nnatom-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnatom-servers)))))
+
+(defun nnatom-retrieve-article (article 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 nnatom-date-format (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnatom-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ `[ nil ,nnatom-group-article-ids ,nnatom-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnatom-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnatom-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnatom-backend "Group %s not found" (or group ""))))
+
+(deffoo nnatom-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnatom))
+ (a (nnatom--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (or (gethash server nnatom-servers)
+ (nnatom--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnatom-group-names)))
+ s))
+ (or s (file-writable-p (nnatom--server-file a))
+ (and (nnoo-close-server nnatom-backend server)
+ (nnheader-report
+ nnatom-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnatom-request-close ()
+ (maphash (lambda (server _)
+ (nnatom--write-server
+ (nnatom--server-address server)))
+ nnatom-servers)
+ (setq nnatom-servers (make-hash-table :test 'equal)
+ nnatom-status-string nil)
+ t)
+
+(defun nnatom--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, possibly with LINKS 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 nnatom-print-content-function #'nnatom--print-content
+ "Function returning a single piece of content (a string).
+It should accept three arguments, a part and its attributes (as returned
+by `nnatom-read-parts-function'), and links.")
+
+(defsubst nnatom--print-part (content headers mime links)
+ (concat
+ (mapconcat (lambda (header)
+ (when-let (((consp header))
+ (m (car header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnatom-print-content-function content headers links)))
+
+(deffoo nnatom-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ (and (setq group nnatom-group)
+ `[ nil ,nnatom-group-article-ids
+ ,nnatom-group-articles
+ ,nnatom-group-article-max-num
+ ,nnatom-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_-" nnatom-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
+ nnatom-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 (nnatom--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (format "--%s\n%s\n" boundary
+ (nnatom--print-part
+ (car part) (cdr part) mime links)))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnatom-backend "No such article")))
+
+(deffoo nnatom-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (if fast (nnatom--group-data group server)
+ (setq server (nnatom--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 nnatom-group group
+ nnatom-group-article-ids (aref g 1)
+ nnatom-group-articles (aref g 2)
+ nnatom-group-article-max-num (aref g 3)
+ nnatom-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnatom-group-article-ids)
+ nnatom-group-article-min-num
+ nnatom-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnatom-backend "Group %s not found" group))))
+
+(deffoo nnatom-close-group (group &optional server)
+ (and (string= group nnatom-group)
+ (setq nnatom-group nil
+ nnatom-group-article-ids (make-hash-table :test 'equal)
+ nnatom-group-articles (make-hash-table :test 'eql)
+ nnatom-group-article-max-num 0
+ nnatom-group-article-min-num 1))
+ (setq server (or server (nnatom--current-server-no-prefix)))
+ (nnatom--write-server server))
+
+(deffoo nnatom-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnatom--parse-feed
+ (or server (nnatom--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 nnatom-request-post (&optional _server)
+ (nnheader-report nnatom-backend "%s is a read only backend" nnatom-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnatom-retrieve-groups (_groups &optional server)
+ (nnatom-request-list (or server (nnatom--current-server-no-prefix)))
+ 'active)
+
+(deffoo nnatom-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnatom-request-group-description (group &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (nnatom--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnatom-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (gethash server nnatom-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 nnatom-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (or (gethash server nnatom-servers)
+ (and ; Open the server to add it to `nnatom-servers'
+ (save-match-data
+ (nnatom-open-server
+ server
+ (cdr ; Get defs and backend.
+ (assoc server (cdr (assq 'nnatom nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnatom)
+ (setq server (match-string 3 server))))
+ (gethash server nnatom-servers)))))
+ (g (or (nnatom--group-data group server)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnatom-group-names)
+ (remhash group s)
+ (and (string= group nnatom-group)
+ (setq nnatom-group new-name))
+ t))
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'address)
+
+;;;; Utilities:
+
+(defmacro nnatom-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnatom-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnatom-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnatom-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnatom-servers)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnatom-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnatom-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnatom-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnatom-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)
+ (nnatom-open-server server defs ',backend))
+ (nnoo-import ,backend (nnatom))))
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-26 14:52 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-01 8:39 ` Eli Zaretskii
2023-07-01 11:33 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2023-07-01 8:39 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: cohen, eric, larsi, 64202, monnier
> Cc: Andrew Cohen <cohen@bu.edu>, Eric Abrahamsen <eric@ericabrahamsen.net>,
> Lars Ingebrigtsen <larsi@gnus.org>, Stefan Monnier <monnier@iro.umontreal.ca>
> Date: Mon, 26 Jun 2023 17:52:47 +0300
> From: Daniel Semyonov via "Bug reports for GNU Emacs,
> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>
> >>>>> Daniel Semyonov writes:
>
> > Attached is an updated version of the patch.
>
> Actually attached this time.
Thanks. Lars, Andrew, Eric: please install when you are satisfied
with this new feature.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-01 8:39 ` Eli Zaretskii
@ 2023-07-01 11:33 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-02 22:59 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-01 11:33 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: cohen, eric, larsi, 64202, monnier
>>>>> Eli Zaretskii writes:
>> >>>>> Daniel Semyonov writes:
>>
>> > Attached is an updated version of the patch.
>>
>> Actually attached this time.
> Thanks. Lars, Andrew, Eric: please install when you are satisfied
> with this new feature.
I'll upload a new patch in (hopefully) a few days based on comments from
Stefan, so please don't install anything yet.
BTW, is there any interest in having this backend also support RSS feeds?
Most feed readers transparently support both Atom and RSS, but I was
initially reluctant to do this too since most Gnus backends are very
specific and there is already an RSS backend. I'm also not sure what to
name a backend which supports both RSS and Atom, and can be inherited
from to support other types of "feeds".
However, I do think that adding this support would be pretty easy, and
Stefan also correctly pointed out to me that RSS has become a generic
term for web feeds, and it seems that many websites today offer Atom
feeds labeled as RSS (or using the well-known RSS icon as a link to it).
Thanks,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-01 11:33 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-02 22:59 ` Eric Abrahamsen
2023-07-03 0:00 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2023-07-02 22:59 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: cohen, larsi, Eli Zaretskii, 64202, monnier
On 07/01/23 14:33 PM, Daniel Semyonov wrote:
>>>>>> Eli Zaretskii writes:
>
> >> >>>>> Daniel Semyonov writes:
> >>
> >> > Attached is an updated version of the patch.
> >>
> >> Actually attached this time.
>
> > Thanks. Lars, Andrew, Eric: please install when you are satisfied
> > with this new feature.
>
> I'll upload a new patch in (hopefully) a few days based on comments from
> Stefan, so please don't install anything yet.
Thanks again for working on this -- I'm getting around to trying it out.
I have a dumb first question: how do I create a Atom group? I wanted to
try it out with the US weather.gov feed for my state:
https://alerts.weather.gov/cap/wa.php?x=0
I tried with "a" in the *Server* buffer, "G m" in the *Group* buffer,
but I guess neither allow for prompting the user for a URL.
I also added
(nnatom "alerts.weather.gov/cap/wa.php?x=0)
to my `gnus-secondary-select-methods' variable, but it said "Server file
alerts.weather.gov/cap/wa.php?x=0 not readable or writable" when I
restarted Gnus. I guess because we're going straight to
`nnatom-open-server', which reads a local file, without ever fetching
the file. We'd have to hit `nnatom--parse-feed' to do that, but I don't
see how we arrive there without already having the server created.
What am I missing?
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-02 22:59 ` Eric Abrahamsen
@ 2023-07-03 0:00 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-03 4:01 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-03 0:00 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: cohen, larsi, Eli Zaretskii, 64202, monnier
>>>>> Eric Abrahamsen writes:
> Thanks again for working on this -- I'm getting around to trying
> it out. I have a dumb first question: how do I create a Atom
> group? I wanted to try it out with the US weather.gov feed for my
> state: https://alerts.weather.gov/cap/wa.php?x=0
> I tried with "a" in the *Server* buffer, "G m" in the *Group*
> buffer, but I guess neither allow for prompting the user for a
> URL.
You can use "B nnatom RET <address> RET" in the group buffer for this
purpose.
> I also added
> (nnatom "alerts.weather.gov/cap/wa.php?x=0)
> to my `gnus-secondary-select-methods' variable, but it said
> "Server file alerts.weather.gov/cap/wa.php?x=0 not readable or
> writable" when I restarted Gnus. I guess because we're going
> straight to `nnatom-open-server', which reads a local file,
> without ever fetching the file. We'd have to hit
> `nnatom--parse-feed' to do that, but I don't see how we arrive
> there without already having the server created.
The server should be allowed to open without an existing local file, as
long as that local file is writable, however...
> What am I missing?
You're not missing anything, you actually just reminded me of a bug I
forgot to fix - the directory holding the local feed data isn't
automatically created if it's missing, which causes 'file-writable-p' to
return nil, preventing the server from opening. As a workaround,
manually create an "atom" subdir under 'gnus-directory'. I'll fix this
in the next version.
However, this particular feed still doesn't work since the comment at
the start of the feed changes the structure of the parsed representation
of the feed when libxml is supported (this also made me realize I
accidentally broke parsing without libxml in the last version, oops).
This is very useful info, as this is the first feed I encountered like
this, and I will fix both those issues too in the next version.
As a quick fix, redefine 'nnatom--read-feed' as:
(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-readable-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)))))
(auth (list 'authors)))
(when (eq (car data) 'top)
(setq data (assq 'feed data)))
(dom-add-child-before data auth)
(catch :stop ; Collect feed authors, stop at first entry.
(dolist (child (cdddr data) data)
(let ((tag (car-safe child)))
(if (eq tag 'entry)
(throw :stop data)
(and (or (eq tag 'author)
(eq tag 'contributor))
(dom-add-child-before auth child))))))))))))
Thanks,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-03 0:00 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-03 4:01 ` Eric Abrahamsen
2023-07-05 12:36 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2023-07-03 4:01 UTC (permalink / raw)
To: 64202
Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army knife of
text editors" <bug-gnu-emacs@gnu.org> writes:
>>>>>> Eric Abrahamsen writes:
>
> > Thanks again for working on this -- I'm getting around to trying
> > it out. I have a dumb first question: how do I create a Atom
> > group? I wanted to try it out with the US weather.gov feed for my
> > state: https://alerts.weather.gov/cap/wa.php?x=0
>
> > I tried with "a" in the *Server* buffer, "G m" in the *Group*
> > buffer, but I guess neither allow for prompting the user for a
> > URL.
>
> You can use "B nnatom RET <address> RET" in the group buffer for this
> purpose.
Huh! In all my years of using and working on Gnus I've never used a
"foreign" server, nor have I really understood what it means. At some
point it would be good to make sure this works via other entrypoints as
well, but so far so good.
> > I also added
>
> > (nnatom "alerts.weather.gov/cap/wa.php?x=0)
>
> > to my `gnus-secondary-select-methods' variable, but it said
> > "Server file alerts.weather.gov/cap/wa.php?x=0 not readable or
> > writable" when I restarted Gnus. I guess because we're going
> > straight to `nnatom-open-server', which reads a local file,
> > without ever fetching the file. We'd have to hit
> > `nnatom--parse-feed' to do that, but I don't see how we arrive
> > there without already having the server created.
>
> The server should be allowed to open without an existing local file, as
> long as that local file is writable, however...
>
> > What am I missing?
>
> You're not missing anything, you actually just reminded me of a bug I
> forgot to fix - the directory holding the local feed data isn't
> automatically created if it's missing, which causes 'file-writable-p' to
> return nil, preventing the server from opening. As a workaround,
> manually create an "atom" subdir under 'gnus-directory'. I'll fix this
> in the next version.
Yup, that did the trick.
> However, this particular feed still doesn't work since the comment at
> the start of the feed changes the structure of the parsed representation
> of the feed when libxml is supported (this also made me realize I
> accidentally broke parsing without libxml in the last version, oops).
> This is very useful info, as this is the first feed I encountered like
> this, and I will fix both those issues too in the next version.
>
> As a quick fix, redefine 'nnatom--read-feed' as:
>
> (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-readable-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)))))
> (auth (list 'authors)))
> (when (eq (car data) 'top)
> (setq data (assq 'feed data)))
> (dom-add-child-before data auth)
> (catch :stop ; Collect feed authors, stop at first entry.
> (dolist (child (cdddr data) data)
> (let ((tag (car-safe child)))
> (if (eq tag 'entry)
> (throw :stop data)
> (and (or (eq tag 'author)
> (eq tag 'contributor))
> (dom-add-child-before auth child))))))))))))
Yes, that fixed it. I'll do some more poking around.
Regarding your earlier question about having this backend handle RSS
too, I'm not aware of any significant difference between the two beyond
the format of the XML. Is that true? If so, it seems like it would make
most sense to merge the code. Have you looked at nnrss? It would be good
to know if there was anything in there worth stealing for nnatom -- if
one of them has a faster parser than the other, for instance, or better
logic for keeping updates efficient.
I just subscribed to a feed with nnrss, and noticed that after I marked
all the items in the feed as read, I couldn't re-enter the group and see
the old items. It gave me "Can't select group". So that's not very
encouraging.
If you do want to expand this to be a general "feed" backend, we might
want to do some boring things like rename it nnfeed.el, and add support
for ridiculous things like JSON feed[0] (why?!?). I assume a derived
backend could handle JSON feeds by setting the appropriate values for
the `nnatom-read-*-function' deffoos?
One of the awkward things about nnrss is that it's never really fit well
into Gnus' one-server-many-groups paradigm, which you allude to in the
nnatom Info section. Do you have any further ideas in that direction?
Thanks,
Eric
[0]: https://www.jsonfeed.org/
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-03 4:01 ` Eric Abrahamsen
@ 2023-07-05 12:36 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-05 17:17 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-05 12:36 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 64202
Sorry, I missed this email (I didn't realize debbugs doesn't forward all
messages to the author of the "bug report").
>>>>> Eric Abrahamsen writes:
> Huh! In all my years of using and working on Gnus I've never used
> a "foreign" server, nor have I really understood what it means. At
> some point it would be good to make sure this works via other
> entrypoints as well, but so far so good.
AFAIK it should work for any entry point which allows you to define a
new server or select method (Atom feeds are represented as servers with
a single group, so there is no way to create a group without a
pre-existing corresponding server).
I'll be honest though, I only ever use this method and
'gnus-secondary-select-methods', so I'm not really sure which other
entry points there are.
> Regarding your earlier question about having this backend handle
> RSS too, I'm not aware of any significant difference between the
> two beyond the format of the XML. Is that true?
Yes, even the XML format is very similar.
> If so, it seems like it would make most sense to merge the
> code. Have you looked at nnrss? It would be good to know if there
> was anything in there worth stealing for nnatom -- if one of them
> has a faster parser than the other, for instance, or better logic
> for keeping updates efficient.
The issue with merging the two is that nnrss saves feed data differently
(both on disk and in memory), and also represents each feed as a group,
with a virtual "server" holding all groups.
I'm not sure if it's possible/a good idea to migrate feed data from
nnrss to a hypothetical merged backend, at least not automatically.
Stefan floated the idea of adding RSS support, deprecating nnrss and
creating an interactive migration command - so users who wish to migrate
will have to do so manually (which should also potentially allow asking
the user some questions if the migration includes some non-trivial
steps).
nnrss does do some cool stuff that nnatom doesn't, though (for example,
it tries very hard to find an RSS feed when you provide it with a link
to a website, while nnatom currently requires a direct link to a feed).
> I just subscribed to a feed with nnrss, and noticed that after I
> marked all the items in the feed as read, I couldn't re-enter the
> group and see the old items. It gave me "Can't select group". So
> that's not very encouraging.
Honestly, from my experience nnrss has many small issues (although I
never encountered this exact issue). It is partly why I developed
nnatom (previously I used a hack documented on the Emacs wiki which
converted Atom feeds to RSS feeds on the fly).
> If you do want to expand this to be a general "feed" backend, we
> might want to do some boring things like rename it nnfeed.el,
This is the name I thought of too, and I guess if two people thought of
it independently it's probably fine.
> and add support for ridiculous things like JSON feed[0] (why?!?). I
> assume a derived backend could handle JSON feeds by setting the
> appropriate values for the `nnatom-read-*-function' deffoos?
I actually attached a derivative "nnjsonfeed" backend I made as an
experiment to one of my previous messages (it doesn't work with the
current version of the patch, but it won't be hard to fix).
It wasn't 100% conforming to the standard (JSON feeds support some weird
features like pagination, which can actually be supported very well in
theory by nnatom, but I didn't feel like doing that), but it worked and
it was very easy to make.
> One of the awkward things about nnrss is that it's never really
> fit well into Gnus' one-server-many-groups paradigm, which you
> allude to in the nnatom Info section. Do you have any further
> ideas in that direction?
Well, nnatom theoretically supports this paradigm, but it doesn't do
this with Atom feeds, since it doesn't really make sense IMO.
However, there is a standardized way to include links to Atom feeds in
HTML documents, so it might be a good idea to support adding them as
servers which show any linked Atom feeds as groups.
I also have a (very experimental) derivative backend using the API of
some website, which exposes various categories of content, which I
expose as groups (this is what I use to test support for multiple groups
in a single server).
As a side note: I had hoped to publish an updated version of the patch
by now, but unfortunately I was a bit under the weather lately, so I
didn't feel like working on it.
> Thanks, Eric
Thanks for your testing and feedback,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-05 12:36 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-05 17:17 ` Eric Abrahamsen
2023-07-05 18:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2023-07-05 17:17 UTC (permalink / raw)
To: 64202; +Cc: daniel
Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army knife of
text editors" <bug-gnu-emacs@gnu.org> writes:
> Sorry, I missed this email (I didn't realize debbugs doesn't forward all
> messages to the author of the "bug report").
No worries, usually I do a reply all, but sometimes forget.
>>>>>> Eric Abrahamsen writes:
>
> > Huh! In all my years of using and working on Gnus I've never used
> > a "foreign" server, nor have I really understood what it means. At
> > some point it would be good to make sure this works via other
> > entrypoints as well, but so far so good.
>
> AFAIK it should work for any entry point which allows you to define a
> new server or select method (Atom feeds are represented as servers with
> a single group, so there is no way to create a group without a
> pre-existing corresponding server).
> I'll be honest though, I only ever use this method and
> 'gnus-secondary-select-methods', so I'm not really sure which other
> entry points there are.
What I usually start with is "G m", for `gnus-group-make-group'. That
prompts for a group name, and also a backend. The viable list of
backends includes all your currently-defined servers, plus the generic
symbols for all defined backends, in this case a plain 'nnatom.
As you point out, that doesn't work for nnatom because each group will
need its own server. What *does* work is to create a group this way,
then put point on the new group and hit "M-e", for
`gnus-group-edit-group-method', put in the actual URL, then "C-c C-c".
Obviously this is horribly baroque and it would be better if
`gnus-group-make-group' could prompt for the URL. No matter what, it
would be good to document the various ways to do this.
> > Regarding your earlier question about having this backend handle
> > RSS too, I'm not aware of any significant difference between the
> > two beyond the format of the XML. Is that true?
>
> Yes, even the XML format is very similar.
>
> > If so, it seems like it would make most sense to merge the
> > code. Have you looked at nnrss? It would be good to know if there
> > was anything in there worth stealing for nnatom -- if one of them
> > has a faster parser than the other, for instance, or better logic
> > for keeping updates efficient.
>
> The issue with merging the two is that nnrss saves feed data differently
> (both on disk and in memory), and also represents each feed as a group,
> with a virtual "server" holding all groups.
> I'm not sure if it's possible/a good idea to migrate feed data from
> nnrss to a hypothetical merged backend, at least not automatically.
>
> Stefan floated the idea of adding RSS support, deprecating nnrss and
> creating an interactive migration command - so users who wish to migrate
> will have to do so manually (which should also potentially allow asking
> the user some questions if the migration includes some non-trivial
> steps).
>
> nnrss does do some cool stuff that nnatom doesn't, though (for example,
> it tries very hard to find an RSS feed when you provide it with a link
> to a website, while nnatom currently requires a direct link to a feed).
Right, I should have been more explicit here -- what I was thinking is
what Stefan suggests: just deprecate nnrss altogether. If it does
anything cool like feed discovery, just steal that code. If you're
inclined to be nice enough to provide a migration function, that's a
bonus.
> > I just subscribed to a feed with nnrss, and noticed that after I
> > marked all the items in the feed as read, I couldn't re-enter the
> > group and see the old items. It gave me "Can't select group". So
> > that's not very encouraging.
>
> Honestly, from my experience nnrss has many small issues (although I
> never encountered this exact issue). It is partly why I developed
> nnatom (previously I used a hack documented on the Emacs wiki which
> converted Atom feeds to RSS feeds on the fly).
>
> > If you do want to expand this to be a general "feed" backend, we
> > might want to do some boring things like rename it nnfeed.el,
>
> This is the name I thought of too, and I guess if two people thought of
> it independently it's probably fine.
Good!
> > and add support for ridiculous things like JSON feed[0] (why?!?). I
> > assume a derived backend could handle JSON feeds by setting the
> > appropriate values for the `nnatom-read-*-function' deffoos?
>
> I actually attached a derivative "nnjsonfeed" backend I made as an
> experiment to one of my previous messages (it doesn't work with the
> current version of the patch, but it won't be hard to fix).
>
> It wasn't 100% conforming to the standard (JSON feeds support some weird
> features like pagination, which can actually be supported very well in
> theory by nnatom, but I didn't feel like doing that), but it worked and
> it was very easy to make.
I missed nnjsonfeed, sorry. That's great you're already working in this
direction. I don't think we need to support absolutely everything it
does (what would pagination look like in Gnus?), just the basics to get
started with.
> > One of the awkward things about nnrss is that it's never really
> > fit well into Gnus' one-server-many-groups paradigm, which you
> > allude to in the nnatom Info section. Do you have any further
> > ideas in that direction?
>
> Well, nnatom theoretically supports this paradigm, but it doesn't do
> this with Atom feeds, since it doesn't really make sense IMO.
> However, there is a standardized way to include links to Atom feeds in
> HTML documents, so it might be a good idea to support adding them as
> servers which show any linked Atom feeds as groups.
It's also perfectly possible that a single website would publish
multiple Atom feeds, right? Like weather.gov, for instance. That would
have an added benefit of letting us simplify the server name from the
full URL (https://alerts.weather.gov/cap/wa.php?x=0) which looks ugly in
the Group buffer, to just eg alerts.weather.gov.
But I guess I don't know why it would matter, really. The only practical
use for wanting multiple feeds under a single server would be to set
some configuration at the server level, that would apply to all feeds
from that server. And at the moment I don't think there are many such
settings (right?).
> I also have a (very experimental) derivative backend using the API of
> some website, which exposes various categories of content, which I
> expose as groups (this is what I use to test support for multiple groups
> in a single server).
>
> As a side note: I had hoped to publish an updated version of the patch
> by now, but unfortunately I was a bit under the weather lately, so I
> didn't feel like working on it.
No rush!
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-05 17:17 ` Eric Abrahamsen
@ 2023-07-05 18:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-05 19:07 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-05 18:50 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 64202
>>>>> Eric Abrahamsen writes:
> Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army
> knife of text editors" <bug-gnu-emacs@gnu.org> writes:
>> AFAIK it should work for any entry point which allows you to
>> define a new server or select method (Atom feeds are represented
>> as servers with a single group, so there is no way to create a
>> group without a pre-existing corresponding server). I'll be
>> honest though, I only ever use this method and
>> 'gnus-secondary-select-methods', so I'm not really sure which
>> other entry points there are.
> What I usually start with is "G m", for
> `gnus-group-make-group'. That prompts for a group name, and also a
> backend. The viable list of backends includes all your
> currently-defined servers, plus the generic symbols for all
> defined backends, in this case a plain 'nnatom.
> As you point out, that doesn't work for nnatom because each group
> will need its own server. What *does* work is to create a group
> this way, then put point on the new group and hit "M-e", for
> `gnus-group-edit-group-method', put in the actual URL, then "C-c
> C-c".
> Obviously this is horribly baroque and it would be better if
> `gnus-group-make-group' could prompt for the URL. No matter what,
> it would be good to document the various ways to do this.
Weirdly enough, 'gnus-group-make-group' accepts an ADDRESS argument, and
the docstring even claims it prompts for it, but the function fails if
you pass it an address it seems.
However, since Gnus knows which backends require an address, and adds
it to the name of the method when present, it shouldn't be hard to fix
this command to actually prompt for an address when needed.
I haven't looked deeply enough into how that function works to know
whether it would actually work as expected in that case though.
>> > Regarding your earlier question about having this backend
>> handle > RSS too, I'm not aware of any significant difference
>> between the > two beyond the format of the XML. Is that true?
>>
>> Yes, even the XML format is very similar.
>>
>> > If so, it seems like it would make most sense to merge the >
>> code. Have you looked at nnrss? It would be good to know if there
>> > was anything in there worth stealing for nnatom -- if one of
>> them > has a faster parser than the other, for instance, or
>> better logic > for keeping updates efficient.
>>
>> The issue with merging the two is that nnrss saves feed data
>> differently (both on disk and in memory), and also represents
>> each feed as a group, with a virtual "server" holding all groups.
>> I'm not sure if it's possible/a good idea to migrate feed data
>> from nnrss to a hypothetical merged backend, at least not
>> automatically.
>>
>> Stefan floated the idea of adding RSS support, deprecating nnrss
>> and creating an interactive migration command - so users who wish
>> to migrate will have to do so manually (which should also
>> potentially allow asking the user some questions if the migration
>> includes some non-trivial steps).
>>
>> nnrss does do some cool stuff that nnatom doesn't, though (for
>> example, it tries very hard to find an RSS feed when you provide
>> it with a link to a website, while nnatom currently requires a
>> direct link to a feed).
> Right, I should have been more explicit here -- what I was
> thinking is what Stefan suggests: just deprecate nnrss
> altogether. If it does anything cool like feed discovery, just
> steal that code. If you're inclined to be nice enough to provide a
> migration function, that's a bonus.
I guess I'll see how hard it would be. First I have to actually
implement RSS support though.
>> > I just subscribed to a feed with nnrss, and noticed that after
>> I > marked all the items in the feed as read, I couldn't re-enter
>> the > group and see the old items. It gave me "Can't select
>> group". So > that's not very encouraging.
>>
>> Honestly, from my experience nnrss has many small issues
>> (although I never encountered this exact issue). It is partly
>> why I developed nnatom (previously I used a hack documented on
>> the Emacs wiki which converted Atom feeds to RSS feeds on the
>> fly).
>>
>> > If you do want to expand this to be a general "feed" backend,
>> we > might want to do some boring things like rename it
>> nnfeed.el,
>>
>> This is the name I thought of too, and I guess if two people
>> thought of it independently it's probably fine.
> Good!
>> > and add support for ridiculous things like JSON feed[0]
>> (why?!?). I > assume a derived backend could handle JSON feeds by
>> setting the > appropriate values for the `nnatom-read-*-function'
>> deffoos?
>>
>> I actually attached a derivative "nnjsonfeed" backend I made as
>> an experiment to one of my previous messages (it doesn't work
>> with the current version of the patch, but it won't be hard to
>> fix).
>>
>> It wasn't 100% conforming to the standard (JSON feeds support
>> some weird features like pagination, which can actually be
>> supported very well in theory by nnatom, but I didn't feel like
>> doing that), but it worked and it was very easy to make.
> I missed nnjsonfeed, sorry. That's great you're already working in
> this direction. I don't think we need to support absolutely
> everything it does (what would pagination look like in Gnus?),
> just the basics to get started with.
The feed itself is paginated, meaning that the entries are spread across
multiple files, with each one pointing to the next with a special tag.
The design of nnatom allows for this since it doesn't necessarily
require parsing the entire feed ahead of time, and also notifies the
backend when a stale (not new or updated) article is reached, so the
backend can intelligently stop (instead of trying to parse thousands of
pages every time you update a group, for example). These capabilities
were actually added in anticipation of a JSON feed backend, the Atom
parser doesn't use them at all.
Gnus itself won't show pages of course, just a list of articles as
normal, but they will come from different JSON feed pages.
>> > One of the awkward things about nnrss is that it's never really
>> > fit well into Gnus' one-server-many-groups paradigm, which you
>> > allude to in the nnatom Info section. Do you have any further >
>> ideas in that direction?
>>
>> Well, nnatom theoretically supports this paradigm, but it doesn't
>> do this with Atom feeds, since it doesn't really make sense IMO.
>> However, there is a standardized way to include links to Atom
>> feeds in HTML documents, so it might be a good idea to support
>> adding them as servers which show any linked Atom feeds as
>> groups.
> It's also perfectly possible that a single website would publish
> multiple Atom feeds, right? Like weather.gov, for instance. That
> would have an added benefit of letting us simplify the server name
> from the full URL (https://alerts.weather.gov/cap/wa.php?x=0)
> which looks ugly in the Group buffer, to just eg
> alerts.weather.gov.
Yes, that's actually what I meant, although looking at real world
examples, it seems most websites either only link to one Atom feed in
the "correct" way, or don't link to any at all in that way.
<https://alerts.weather.gov/cap> doesn't link to any feed in the
standard way at all, for example.
> But I guess I don't know why it would matter, really. The only
> practical use for wanting multiple feeds under a single server
> would be to set some configuration at the server level, that would
> apply to all feeds from that server. And at the moment I don't
> think there are many such settings (right?).
Actually, since the various parsing functions are stored in server
variables, all of them can be changed on a per-server basis, which is
pretty cool.
As an example, after I add support for fetching feeds contained in HTML,
I can imagine a scenario where a user adds a website which publishes
multiple, non-standard feeds, and fixes the parsing of all of them at
once by providing some customized parsing functions for that specific
server.
This is a contrived example, but I know at least of youtube, which
publishes slightly customized Atom feeds for each channel, so this is
already useful.
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-05 18:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-05 19:07 ` Eric Abrahamsen
2023-07-15 0:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2023-07-05 19:07 UTC (permalink / raw)
To: 64202; +Cc: daniel
Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army knife of
text editors" <bug-gnu-emacs@gnu.org> writes:
>>>>>> Eric Abrahamsen writes:
>
> > Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army
> > knife of text editors" <bug-gnu-emacs@gnu.org> writes:
>
> >> AFAIK it should work for any entry point which allows you to
> >> define a new server or select method (Atom feeds are represented
> >> as servers with a single group, so there is no way to create a
> >> group without a pre-existing corresponding server). I'll be
> >> honest though, I only ever use this method and
> >> 'gnus-secondary-select-methods', so I'm not really sure which
> >> other entry points there are.
>
> > What I usually start with is "G m", for
> > `gnus-group-make-group'. That prompts for a group name, and also a
> > backend. The viable list of backends includes all your
> > currently-defined servers, plus the generic symbols for all
> > defined backends, in this case a plain 'nnatom.
>
> > As you point out, that doesn't work for nnatom because each group
> > will need its own server. What *does* work is to create a group
> > this way, then put point on the new group and hit "M-e", for
> > `gnus-group-edit-group-method', put in the actual URL, then "C-c
> > C-c".
>
> > Obviously this is horribly baroque and it would be better if
> > `gnus-group-make-group' could prompt for the URL. No matter what,
> > it would be good to document the various ways to do this.
>
> Weirdly enough, 'gnus-group-make-group' accepts an ADDRESS argument, and
> the docstring even claims it prompts for it, but the function fails if
> you pass it an address it seems.
> However, since Gnus knows which backends require an address, and adds
> it to the name of the method when present, it shouldn't be hard to fix
> this command to actually prompt for an address when needed.
> I haven't looked deeply enough into how that function works to know
> whether it would actually work as expected in that case though.
Where do you see that Gnus knows which backends require an address? That
would be very handy. But my reading of this function is that we don't
even known that the backend is loaded until the end of the group
creation process. You could probably mildly abuse the
'request-create-group server function to further prompt the user for the
URL.
It is a bit annoying that the ADDRESS argument is in there, but not
prompted for. It looks like that's been the case for at least two
decades, though.
> >> > Regarding your earlier question about having this backend
> >> handle > RSS too, I'm not aware of any significant difference
> >> between the > two beyond the format of the XML. Is that true?
> >>
> >> Yes, even the XML format is very similar.
> >>
> >> > If so, it seems like it would make most sense to merge the >
> >> code. Have you looked at nnrss? It would be good to know if there
> >> > was anything in there worth stealing for nnatom -- if one of
> >> them > has a faster parser than the other, for instance, or
> >> better logic > for keeping updates efficient.
> >>
> >> The issue with merging the two is that nnrss saves feed data
> >> differently (both on disk and in memory), and also represents
> >> each feed as a group, with a virtual "server" holding all groups.
> >> I'm not sure if it's possible/a good idea to migrate feed data
> >> from nnrss to a hypothetical merged backend, at least not
> >> automatically.
> >>
> >> Stefan floated the idea of adding RSS support, deprecating nnrss
> >> and creating an interactive migration command - so users who wish
> >> to migrate will have to do so manually (which should also
> >> potentially allow asking the user some questions if the migration
> >> includes some non-trivial steps).
> >>
> >> nnrss does do some cool stuff that nnatom doesn't, though (for
> >> example, it tries very hard to find an RSS feed when you provide
> >> it with a link to a website, while nnatom currently requires a
> >> direct link to a feed).
>
> > Right, I should have been more explicit here -- what I was
> > thinking is what Stefan suggests: just deprecate nnrss
> > altogether. If it does anything cool like feed discovery, just
> > steal that code. If you're inclined to be nice enough to provide a
> > migration function, that's a bonus.
>
> I guess I'll see how hard it would be. First I have to actually
> implement RSS support though.
I also don't think it would hurt to start with what we've got, and
incrementally add to it after an initial deployment. The important thing
would be factoring out a nnfeed.el backend, then providing nnatom.el on
top of that. The rest could come as you get to it.
> >> > I just subscribed to a feed with nnrss, and noticed that after
> >> I > marked all the items in the feed as read, I couldn't re-enter
> >> the > group and see the old items. It gave me "Can't select
> >> group". So > that's not very encouraging.
> >>
> >> Honestly, from my experience nnrss has many small issues
> >> (although I never encountered this exact issue). It is partly
> >> why I developed nnatom (previously I used a hack documented on
> >> the Emacs wiki which converted Atom feeds to RSS feeds on the
> >> fly).
> >>
> >> > If you do want to expand this to be a general "feed" backend,
> >> we > might want to do some boring things like rename it
> >> nnfeed.el,
> >>
> >> This is the name I thought of too, and I guess if two people
> >> thought of it independently it's probably fine.
>
> > Good!
>
> >> > and add support for ridiculous things like JSON feed[0]
> >> (why?!?). I > assume a derived backend could handle JSON feeds by
> >> setting the > appropriate values for the `nnatom-read-*-function'
> >> deffoos?
> >>
> >> I actually attached a derivative "nnjsonfeed" backend I made as
> >> an experiment to one of my previous messages (it doesn't work
> >> with the current version of the patch, but it won't be hard to
> >> fix).
> >>
> >> It wasn't 100% conforming to the standard (JSON feeds support
> >> some weird features like pagination, which can actually be
> >> supported very well in theory by nnatom, but I didn't feel like
> >> doing that), but it worked and it was very easy to make.
>
> > I missed nnjsonfeed, sorry. That's great you're already working in
> > this direction. I don't think we need to support absolutely
> > everything it does (what would pagination look like in Gnus?),
> > just the basics to get started with.
>
> The feed itself is paginated, meaning that the entries are spread across
> multiple files, with each one pointing to the next with a special tag.
> The design of nnatom allows for this since it doesn't necessarily
> require parsing the entire feed ahead of time, and also notifies the
> backend when a stale (not new or updated) article is reached, so the
> backend can intelligently stop (instead of trying to parse thousands of
> pages every time you update a group, for example). These capabilities
> were actually added in anticipation of a JSON feed backend, the Atom
> parser doesn't use them at all.
>
> Gnus itself won't show pages of course, just a list of articles as
> normal, but they will come from different JSON feed pages.
I see! Sounds like a reasonable optimization for making updates faster.
> >> > One of the awkward things about nnrss is that it's never really
> >> > fit well into Gnus' one-server-many-groups paradigm, which you
> >> > allude to in the nnatom Info section. Do you have any further >
> >> ideas in that direction?
> >>
> >> Well, nnatom theoretically supports this paradigm, but it doesn't
> >> do this with Atom feeds, since it doesn't really make sense IMO.
> >> However, there is a standardized way to include links to Atom
> >> feeds in HTML documents, so it might be a good idea to support
> >> adding them as servers which show any linked Atom feeds as
> >> groups.
>
> > It's also perfectly possible that a single website would publish
> > multiple Atom feeds, right? Like weather.gov, for instance. That
> > would have an added benefit of letting us simplify the server name
> > from the full URL (https://alerts.weather.gov/cap/wa.php?x=0)
> > which looks ugly in the Group buffer, to just eg
> > alerts.weather.gov.
>
> Yes, that's actually what I meant, although looking at real world
> examples, it seems most websites either only link to one Atom feed in
> the "correct" way, or don't link to any at all in that way.
>
> <https://alerts.weather.gov/cap> doesn't link to any feed in the
> standard way at all, for example.
>
> > But I guess I don't know why it would matter, really. The only
> > practical use for wanting multiple feeds under a single server
> > would be to set some configuration at the server level, that would
> > apply to all feeds from that server. And at the moment I don't
> > think there are many such settings (right?).
>
> Actually, since the various parsing functions are stored in server
> variables, all of them can be changed on a per-server basis, which is
> pretty cool.
>
> As an example, after I add support for fetching feeds contained in HTML,
> I can imagine a scenario where a user adds a website which publishes
> multiple, non-standard feeds, and fixes the parsing of all of them at
> once by providing some customized parsing functions for that specific
> server.
> This is a contrived example, but I know at least of youtube, which
> publishes slightly customized Atom feeds for each channel, so this is
> already useful.
Thanks for the background. So it does sound like one Gnus server per
remote server is the way to go.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-05 19:07 ` Eric Abrahamsen
@ 2023-07-15 0:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-15 1:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-18 17:32 ` Eric Abrahamsen
0 siblings, 2 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-15 0:59 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 64202
[-- Attachment #1: Type: text/plain, Size: 1365 bytes --]
>>>>> Eric Abrahamsen writes:
> Where do you see that Gnus knows which backends require an
> address? That would be very handy.
Forgot to answer this -- 'gnus-valid-select-methods' holds this
information (and a bunch of other info too).
> But my reading of this function is that we don't even known that
> the backend is loaded until the end of the group creation
> process. You could probably mildly abuse the 'request-create-group
> server function to further prompt the user for the URL.
> It is a bit annoying that the ADDRESS argument is in there, but
> not prompted for. It looks like that's been the case for at least
> two decades, though.
I'll add this to the pile of stuff I wanna change in Gnus once I'm
satisfied with this backend (quite a large pile at this point :).
In any case, I still didn't have much time to work on the backend
unfortunately, but I attached a patch which incorporates the fixes from
my last message + changes based on comments from Stefan.
Things left to do:
1. Ensure support for none-libxml builds (I should probably figure out
how ERT works to make this a non-issue going forward).
2. Factor out nnfeed.el and base nnatom on top of it (shouldn't be hard).
3. Add support for RSS (and steal cool stuff from nnrss).
4. Support Atom feeds linked in HTML documents.
Regards,
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 41711 bytes --]
From 0ddc9702d2205dc8323a9f172e7378c02946b157 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 58 ++++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 796 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 862 insertions(+)
create mode 100644 lisp/gnus/nnatom.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8d25e868c8a..9184a4035df 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,62 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 the feed specifies a MIME type),
+even base64 encoded files (like images for example), which are
+supported by Atom.
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@item
+Designed with modularity in mind, the back end theoretically supports
+features which aren't available in Atom (and thus aren't actually
+implemented in practice). For example, the back end operates under
+the assumption that ``servers'' (Atom feeds) can have multiple groups,
+when in reality the parsing functions will only ever return servers
+with a single group. In addition, all parsing steps and some of the
+printing is done in functions stored in server variables, to allow
+very easily defining new back ends for different kinds of feeds by
+inheriting from @code{nnatom}; these are called
+@code{nnatom-read-*-function} and
+@code{nnatom-print-content-function}, and their requirements are
+detailed in their docstrings. A macro is provided to ease creation of
+new inheriting backends.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for @var{backend}. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+@end itemize
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index d7f5fdc4cbb..16fc419834c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -386,6 +386,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** Python Mode
---
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..d35d709c448 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1343,6 +1343,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..6ea47c317c0
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,796 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+;; Other types of feeds may be supported by providing custom parsing
+;; functions.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'gnus)
+
+(nnoo-declare nnatom)
+
+(defvoo nnatom-backend 'nnatom
+ "Symbol which identifies this backend.")
+
+(defvoo nnatom-status-string nil
+ "Last status message reported by this backend.")
+
+;;;; 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)))))
+ (auth (list 'authors)))
+ (when (eq (car data) 'top)
+ (setq data (assq 'feed data)))
+ (dom-add-child-before data auth)
+ (catch :stop ; Collect feed authors, stop at first entry.
+ (dolist (child (cdddr data))
+ (let ((tag (car-safe child)))
+ (if (eq tag 'entry)
+ (throw :stop data)
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child)))))
+ data)))))))
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+
+(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 (cddr data)))
+ (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))))))
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+
+(defun nnatom--read-article-or-group-authors (article-or-group)
+ "Return the authors of ARTICLE-OR-GROUP, or nil."
+ (when-let
+ ((a (string-trim-right
+ (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)))
+ (concat
+ (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))
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+
+(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)))
+
+(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))))
+
+(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))))
+
+(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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ link label))))))))
+ (dom-children (dom-child-by-tag article 'links)))))
+
+(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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+
+;;;; Feed I/O:
+
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ "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
+`nnatom-read-group-function').")
+
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ "Function returning a cons cell of a group and remaining data from a feed.")
+
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ "Function returning a cons cell of an article and remaining data from a group.
+It should accept a two arguments, a Lisp object representing a feed,
+and a flag indicating whether the last article was stale (not new or updated).")
+
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ "Function returning the title of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ "Function returning the description of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-group-author-function
+ #'nnatom--read-article-or-group-authors
+ "Function returning the author of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ "Function returning the ID of an article.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ "Function returning the subject of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ "Function returning the publish date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ "Function returning the update date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-authors
+ "Function returning the author of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-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 \"-_nnatom_-\",
+and is automatically modified to match the name of the back end.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ "Function returning all links contained in an article.
+For the default `nnatom-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.")
+
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ "Function returning an alist associating parts of an article to their headers.
+For the default `nnatom-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 `nnatom-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.")
+
+(defvoo nnatom-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 `nnatom-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnatom-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnatom--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnatom-backend)
+ "nn")
+ (gnus-newsgroup-savable-name server))
+ gnus-directory))
+
+(defun nnatom--read-server (server)
+ "Read SERVER's information from `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnatom-servers))
+ (nnheader-report nnatom-backend "Can't read %s" server)))
+
+(defun nnatom--write-server (server)
+ "Write SERVER's information to `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnatom-servers))
+ ((hash-table-p s)))
+ (with-temp-file f
+ (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n"
+ (prin1 s (current-buffer)) "\n")
+ t)
+ t)
+ (nnheader-report nnatom-backend "Can't write %s" f)))
+
+(defun nnatom--server-address (server)
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnatom-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat
+ (symbol-name nnatom-backend) ":"
+ server)))))
+ server))
+ server))
+
+(defun nnatom--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnatom--server-address feed))
+ (s (or (gethash feed nnatom-servers) (nnatom--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnatom-read-feed-function feed group)
+ s (or (gethash feed nnatom-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (funcall nnatom-read-group-function data)))
+ (cg (prog1 (car cg) (setq data (cdr cg)))))
+ (let* ((name (funcall nnatom-read-title-function cg)) ; Real name
+ (group (gethash name nnatom-group-names name)) ; (Maybe) fake name
+ (info (gnus-get-info
+ (concat (symbol-name nnatom-backend) "+" feed ":" group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnatom-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 nnatom-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnatom-read-article-function cg stale))
+ (article (prog1 (car article) (setq cg (cdr article)))))
+ (when-let ((id (funcall nnatom-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnatom-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnatom-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 (cl-incf max))))
+ (publish (funcall nnatom-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnatom-read-author-function article)
+ group-author group)
+ ,(or (funcall nnatom-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnatom-read-links-function article)
+ ,(funcall nnatom-read-parts-function article)
+ ,(funcall nnatom-read-headers-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnatom-servers))))
+
+;;;; Gnus backend functions:
+
+(defvoo nnatom-group nil
+ "Name of the current group.")
+
+(defvoo nnatom-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnatom-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 nnatom-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnatom-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(defvar nnatom-date-format "%F %X"
+ "Format of displayed dates.")
+
+(nnoo-define-basics nnatom)
+
+(defun nnatom--current-server-no-prefix ()
+ (string-remove-prefix (concat (symbol-name nnatom-backend) "+")
+ (nnoo-current-server nnatom-backend)))
+
+(defun nnatom--group-data (group &optional server)
+ (let ((s (gethash server nnatom-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnatom--current-server-no-prefix))
+ (setq s (gethash c nnatom-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnatom-servers)))))
+
+(defun nnatom-retrieve-article (article 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 nnatom-date-format (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnatom-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ `[ nil ,nnatom-group-article-ids ,nnatom-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnatom-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnatom-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnatom-backend "Group %s not found" (or group ""))))
+
+(deffoo nnatom-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnatom))
+ (a (nnatom--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (or (gethash server nnatom-servers)
+ (nnatom--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnatom-group-names)))
+ s))
+ (or s (file-writable-p (nnatom--server-file a))
+ (and (nnoo-close-server nnatom-backend server)
+ (nnheader-report
+ nnatom-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnatom-request-close ()
+ (maphash (lambda (server _)
+ (nnatom--write-server
+ (nnatom--server-address server)))
+ nnatom-servers)
+ (setq nnatom-servers (make-hash-table :test 'equal)
+ nnatom-status-string nil)
+ t)
+
+(defun nnatom--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, possibly with LINKS 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 nnatom-print-content-function #'nnatom--print-content
+ "Function returning a single piece of content (a string).
+It should accept three arguments, a part and its attributes (as returned
+by `nnatom-read-parts-function'), and links.")
+
+(defun nnatom--print-part (content headers mime links)
+ (concat
+ (mapconcat (lambda (header)
+ (when-let ((m (car-safe header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnatom-print-content-function content headers links)))
+
+(deffoo nnatom-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ (and (setq group nnatom-group)
+ `[ nil ,nnatom-group-article-ids
+ ,nnatom-group-articles
+ ,nnatom-group-article-max-num
+ ,nnatom-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_-" nnatom-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
+ nnatom-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 (nnatom--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (format "--%s\n%s\n" boundary
+ (nnatom--print-part
+ (car part) (cdr part) mime links)))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnatom-backend "No such article")))
+
+(deffoo nnatom-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (if fast (nnatom--group-data group server)
+ (setq server (nnatom--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 nnatom-group group
+ nnatom-group-article-ids (aref g 1)
+ nnatom-group-articles (aref g 2)
+ nnatom-group-article-max-num (aref g 3)
+ nnatom-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnatom-group-article-ids)
+ nnatom-group-article-min-num
+ nnatom-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnatom-backend "Group %s not found" group))))
+
+(deffoo nnatom-close-group (group &optional server)
+ (and (string= group nnatom-group)
+ (setq nnatom-group nil
+ nnatom-group-article-ids (make-hash-table :test 'equal)
+ nnatom-group-articles (make-hash-table :test 'eql)
+ nnatom-group-article-max-num 0
+ nnatom-group-article-min-num 1))
+ (setq server (or server (nnatom--current-server-no-prefix)))
+ (nnatom--write-server server))
+
+(deffoo nnatom-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnatom--parse-feed
+ (or server (nnatom--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 nnatom-request-post (&optional _server)
+ (nnheader-report nnatom-backend "%s is a read only backend" nnatom-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnatom-retrieve-groups (_groups &optional server)
+ (nnatom-request-list (or server (nnatom--current-server-no-prefix)))
+ 'active)
+
+(deffoo nnatom-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnatom-request-group-description (group &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (nnatom--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnatom-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (gethash server nnatom-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 nnatom-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (or (gethash server nnatom-servers)
+ (and ; Open the server to add it to `nnatom-servers'
+ (save-match-data
+ (nnatom-open-server
+ server
+ (cdr ; Get defs and backend.
+ (assoc server (cdr (assq 'nnatom nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnatom)
+ (setq server (match-string 3 server))))
+ (gethash server nnatom-servers)))))
+ (g (or (nnatom--group-data group server)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnatom-group-names)
+ (remhash group s)
+ (and (string= group nnatom-group)
+ (setq nnatom-group new-name))
+ t))
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'address)
+
+;;;; Utilities:
+
+(defmacro nnatom-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnatom-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnatom-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnatom-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnatom-servers)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnatom-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnatom-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnatom-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnatom-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)
+ (nnatom-open-server server defs ',backend))
+ (nnoo-import ,backend (nnatom))))
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-15 0:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-15 1:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-18 17:32 ` Eric Abrahamsen
1 sibling, 0 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-15 1:26 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 64202
[-- Attachment #1: Type: text/plain, Size: 261 bytes --]
>>>>> Daniel Semyonov writes:
> I attached a patch which incorporates the fixes
> from my last message + changes based on comments from Stefan.
I sent a slightly out of date version of the patch with my last message.
Attached is the current version.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 41725 bytes --]
From 63df5f6f046b3aa1dacfeccd4649cf4af381c0d0 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 58 ++++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 797 ++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 863 insertions(+)
create mode 100644 lisp/gnus/nnatom.el
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 8d25e868c8a..9184a4035df 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,62 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 the feed specifies a MIME type),
+even base64 encoded files (like images for example), which are
+supported by Atom.
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@item
+Designed with modularity in mind, the back end theoretically supports
+features which aren't available in Atom (and thus aren't actually
+implemented in practice). For example, the back end operates under
+the assumption that ``servers'' (Atom feeds) can have multiple groups,
+when in reality the parsing functions will only ever return servers
+with a single group. In addition, all parsing steps and some of the
+printing is done in functions stored in server variables, to allow
+very easily defining new back ends for different kinds of feeds by
+inheriting from @code{nnatom}; these are called
+@code{nnatom-read-*-function} and
+@code{nnatom-print-content-function}, and their requirements are
+detailed in their docstrings. A macro is provided to ease creation of
+new inheriting backends.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for @var{backend}. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+@end itemize
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index d7f5fdc4cbb..16fc419834c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -386,6 +386,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** Python Mode
---
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index fc8518512ee..d35d709c448 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1343,6 +1343,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..e58f48bcf0e
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,797 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+;; Other types of feeds may be supported by providing custom parsing
+;; functions.
+
+;;; Code:
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'subr-x))
+
+(require 'gnus)
+(require 'nnheader)
+(require 'nnoo)
+(require 'gnus-group)
+(require 'mm-url)
+(require 'dom)
+
+(defgroup nnatom nil
+ "Atom backend for Gnus."
+ :group 'gnus)
+
+(nnoo-declare nnatom)
+
+(defvoo nnatom-backend 'nnatom
+ "Symbol which identifies this backend.")
+
+(defvoo nnatom-status-string nil
+ "Last status message reported by this backend.")
+
+;;;; 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)))))
+ (auth (list 'authors)))
+ (when (eq (car data) 'top)
+ (setq data (assq 'feed data)))
+ (dom-add-child-before data auth)
+ (catch :stop ; Collect feed authors, stop at first entry.
+ (dolist (child (cdddr data))
+ (let ((tag (car-safe child)))
+ (if (eq tag 'entry)
+ (throw :stop data)
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child)))))
+ data)))))))
+
+(defun nnatom--read-group (data)
+ "Return the next group and the remaining DATA in a cons cell, or nil."
+ `(,data))
+
+(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 (cddr data)))
+ (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))))))
+
+(defun nnatom--read-title (group)
+ "Return the title of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'title)))
+
+(defun nnatom--read-description (group)
+ "Return the description of GROUP, or nil."
+ (dom-text (dom-child-by-tag group 'subtitle)))
+
+(defun nnatom--read-article-or-group-authors (article-or-group)
+ "Return the authors of ARTICLE-OR-GROUP, or nil."
+ (when-let
+ ((a (string-trim-right
+ (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)))
+ (concat
+ (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))
+
+(defun nnatom--read-subject (article)
+ "Return the subject of ARTICLE, or nil."
+ (dom-text (dom-child-by-tag article 'title)))
+
+(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)))
+
+(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))))
+
+(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))))
+
+(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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ link label))))))))
+ (dom-children (dom-child-by-tag article 'links)))))
+
+(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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+
+;;;; Feed I/O:
+
+(defvoo nnatom-read-feed-function #'nnatom--read-feed
+ "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
+`nnatom-read-group-function').")
+
+(defvoo nnatom-read-group-function #'nnatom--read-group
+ "Function returning a cons cell of a group and remaining data from a feed.")
+
+(defvoo nnatom-read-article-function #'nnatom--read-article
+ "Function returning a cons cell of an article and remaining data from a group.
+It should accept a two arguments, a Lisp object representing a feed,
+and a flag indicating whether the last article was stale (not new or updated).")
+
+(defvoo nnatom-read-title-function #'nnatom--read-title
+ "Function returning the title of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-description-function #'nnatom--read-description
+ "Function returning the description of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-group-author-function
+ #'nnatom--read-article-or-group-authors
+ "Function returning the author of a group (a string).
+It should accept a single argument, a Lisp object representing a group.")
+
+(defvoo nnatom-read-id-function #'nnatom--read-id
+ "Function returning the ID of an article.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-subject-function #'nnatom--read-subject
+ "Function returning the subject of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-publish-date-function #'nnatom--read-publish
+ "Function returning the publish date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-update-date-function #'nnatom--read-update
+ "Function returning the update date of an article (a time value).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-author-function #'nnatom--read-article-or-group-authors
+ "Function returning the author of an article (a string).
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-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 \"-_nnatom_-\",
+and is automatically modified to match the name of the back end.
+It should accept a single argument, a Lisp object representing an article.")
+
+(defvoo nnatom-read-links-function #'nnatom--read-links
+ "Function returning all links contained in an article.
+For the default `nnatom-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.")
+
+(defvoo nnatom-read-parts-function #'nnatom--read-parts
+ "Function returning an alist associating parts of an article to their headers.
+For the default `nnatom-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 `nnatom-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.")
+
+(defvoo nnatom-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 `nnatom-group-articles').
+- MAX is the maximum article number.
+- MIN is the minimum article number.
+- DESCRIPTION is the group description.")
+
+(defvoo nnatom-group-names (make-hash-table :test 'equal)
+ "Hash table mapping real group names to their custom name.")
+
+(defun nnatom--server-file (server)
+ "Return the file containing data for SERVER."
+ (expand-file-name (format "%s/%s.eld"
+ (string-trim (symbol-name nnatom-backend)
+ "nn")
+ (gnus-newsgroup-savable-name server))
+ gnus-directory))
+
+(defun nnatom--read-server (server)
+ "Read SERVER's information from `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-readable-p f)))
+ (with-temp-buffer
+ (insert-file-contents f)
+ (goto-char (point-min))
+ (puthash server (read (current-buffer)) nnatom-servers))
+ (nnheader-report nnatom-backend "Can't read %s" server)))
+
+(defun nnatom--write-server (server)
+ "Write SERVER's information to `nnatom-directory'."
+ (if-let ((f (nnatom--server-file server))
+ ((file-writable-p f)))
+ (if-let ((s (gethash server nnatom-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 nnatom-backend "Can't write %s" f)))
+
+(defun nnatom--server-address (server)
+ (if (string-suffix-p "-ephemeral" server)
+ (setq server (or (cadr (assq (nnoo-symbol nnatom-backend 'address)
+ (cddr (gnus-server-to-method
+ (concat
+ (symbol-name nnatom-backend) ":"
+ server)))))
+ server))
+ server))
+
+(defun nnatom--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnatom--server-address feed))
+ (s (or (gethash feed nnatom-servers) (nnatom--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnatom-read-feed-function feed group)
+ s (or (gethash feed nnatom-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (funcall nnatom-read-group-function data)))
+ (cg (prog1 (car cg) (setq data (cdr cg)))))
+ (let* ((name (funcall nnatom-read-title-function cg)) ; Real name
+ (group (gethash name nnatom-group-names name)) ; (Maybe) fake name
+ (info (gnus-get-info
+ (concat (symbol-name nnatom-backend) "+" feed ":" group)))
+ (g (or (gethash group s)
+ `[ ,name ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""]))
+ (desc (funcall nnatom-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 nnatom-read-group-author-function cg))
+ stale)
+ (and desc (aset g 5 desc))
+ (while-let ((article (funcall nnatom-read-article-function cg stale))
+ (article (prog1 (car article) (setq cg (cdr article)))))
+ (when-let ((id (funcall nnatom-read-id-function article))
+ (id (format "<%s@%s.%s>" id name nnatom-backend)))
+ (let* ((num (gethash id ids))
+ (update (funcall nnatom-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 (cl-incf max))))
+ (publish (funcall nnatom-read-publish-date-function
+ article)))
+ (setf
+ (gethash id (aref g 1)) num
+ (gethash num (aref g 2))
+ `[ ,id
+ ,(or (funcall nnatom-read-author-function article)
+ group-author group)
+ ,(or (funcall nnatom-read-subject-function article)
+ "no subject")
+ ,(or publish update '(0 0)) ; published
+ ,(or update publish '(0 0)) ; updated
+ ,(funcall nnatom-read-links-function article)
+ ,(funcall nnatom-read-parts-function article)
+ ,(funcall nnatom-read-headers-function article)]
+ stale nil))
+ (setq stale t)))))
+ (puthash group g s)))
+ (puthash feed s nnatom-servers))))
+
+;;;; Gnus backend functions:
+
+(defvoo nnatom-group nil
+ "Name of the current group.")
+
+(defvoo nnatom-group-article-ids (make-hash-table :test 'equal)
+ "Hash table mapping article IDs to their article number.")
+
+(defvoo nnatom-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 nnatom-group-article-max-num 0
+ "Maximum article number for the current group.")
+
+(defvoo nnatom-group-article-min-num 1
+ "Minimum article number for the current group.")
+
+(defvar nnatom-date-format "%F %X"
+ "Format of displayed dates.")
+
+(nnoo-define-basics nnatom)
+
+(defun nnatom--current-server-no-prefix ()
+ (string-remove-prefix (concat (symbol-name nnatom-backend) "+")
+ (nnoo-current-server nnatom-backend)))
+
+(defun nnatom--group-data (group &optional server)
+ (let ((s (gethash server nnatom-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnatom--current-server-no-prefix))
+ (setq s (gethash c nnatom-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnatom-servers)))))
+
+(defun nnatom-retrieve-article (article 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 nnatom-date-format (aref a 3))
+ (aref a 0)))
+ (insert "404 Article not found.\n.\n")))
+
+(deffoo nnatom-retrieve-headers (articles &optional group server _fetch-old)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ `[ nil ,nnatom-group-article-ids ,nnatom-group-articles
+ nil nil nil])))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (or (and (stringp (car articles))
+ (mapc (lambda (a)
+ (nnatom-retrieve-article
+ (gethash a (aref g 2)) g))
+ articles))
+ (and (numberp (car articles))
+ (range-map (lambda (a) (nnatom-retrieve-article a g))
+ articles)))
+ 'headers)
+ (nnheader-report nnatom-backend "Group %s not found" (or group ""))))
+
+(deffoo nnatom-open-server (server &optional defs backend)
+ (let ((backend (or backend 'nnatom))
+ (a (nnatom--server-address server))
+ s)
+ (nnoo-change-server backend server defs)
+ (when (setq s (or (gethash server nnatom-servers)
+ (nnatom--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnatom-group-names)))
+ s))
+ (or s (file-writable-p (nnatom--server-file a))
+ (and (nnoo-close-server nnatom-backend server)
+ (nnheader-report
+ nnatom-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnatom-request-close ()
+ (maphash (lambda (server _)
+ (nnatom--write-server
+ (nnatom--server-address server)))
+ nnatom-servers)
+ (setq nnatom-servers (make-hash-table :test 'equal)
+ nnatom-status-string nil)
+ t)
+
+(defun nnatom--print-content (content attributes links)
+ "Return CONTENT formatted according to ATTRIBUTES, possibly with LINKS 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 nnatom-print-content-function #'nnatom--print-content
+ "Function returning a single piece of content (a string).
+It should accept three arguments, a part and its attributes (as returned
+by `nnatom-read-parts-function'), and links.")
+
+(defun nnatom--print-part (content headers mime links)
+ (concat
+ (mapconcat (lambda (header)
+ (when-let ((m (car-safe header))
+ ((member m mime)))
+ (format "%s: %s\n" m (cdr header))))
+ headers)
+ "\n"
+ (funcall nnatom-print-content-function content headers links)))
+
+(deffoo nnatom-request-article (article &optional group server to-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (nnatom--group-data group server)
+ (and (setq group nnatom-group)
+ `[ nil ,nnatom-group-article-ids
+ ,nnatom-group-articles
+ ,nnatom-group-article-max-num
+ ,nnatom-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_-" nnatom-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
+ nnatom-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 (nnatom--print-part
+ (caar parts) (cdar parts) mime links)
+ (setq parts nil)))
+ (mapconcat (lambda (part)
+ (format "--%s\n%s\n" boundary
+ (nnatom--print-part
+ (car part) (cdr part) mime links)))
+ parts)
+ (if multi (format "--%s--" boundary) "\n")))
+ `(,group . ,num))
+ (nnheader-report nnatom-backend "No such article")))
+
+(deffoo nnatom-request-group (group &optional server fast _info)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (if-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (or (if fast (nnatom--group-data group server)
+ (setq server (nnatom--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 nnatom-group group
+ nnatom-group-article-ids (aref g 1)
+ nnatom-group-articles (aref g 2)
+ nnatom-group-article-max-num (aref g 3)
+ nnatom-group-article-min-num (aref g 4))
+ (insert (format "211 %s %s %s \"%s\""
+ (hash-table-count nnatom-group-article-ids)
+ nnatom-group-article-min-num
+ nnatom-group-article-max-num group))
+ t)
+ (insert "404 group not found")
+ (nnheader-report nnatom-backend "Group %s not found" group))))
+
+(deffoo nnatom-close-group (group &optional server)
+ (and (string= group nnatom-group)
+ (setq nnatom-group nil
+ nnatom-group-article-ids (make-hash-table :test 'equal)
+ nnatom-group-articles (make-hash-table :test 'eql)
+ nnatom-group-article-max-num 0
+ nnatom-group-article-min-num 1))
+ (setq server (or server (nnatom--current-server-no-prefix)))
+ (nnatom--write-server server))
+
+(deffoo nnatom-request-list (&optional server)
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (when-let ((p (point))
+ (s (nnatom--parse-feed
+ (or server (nnatom--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 nnatom-request-post (&optional _server)
+ (nnheader-report nnatom-backend "%s is a read only backend" nnatom-backend))
+
+;;;; Optional back end functions:
+
+(deffoo nnatom-retrieve-groups (_groups &optional server)
+ (nnatom-request-list (or server (nnatom--current-server-no-prefix)))
+ 'active)
+
+(deffoo nnatom-request-type (_group &optional _article)
+ 'unknown)
+
+(deffoo nnatom-request-group-description (group &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (g (nnatom--group-data group server)))
+ (with-current-buffer nntp-server-buffer
+ (erase-buffer)
+ (insert group " " (aref g 5) "\n"))))
+
+(deffoo nnatom-request-list-newsgroups (&optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (gethash server nnatom-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 nnatom-request-rename-group (group new-name &optional server)
+ (when-let ((server (or server (nnatom--current-server-no-prefix)))
+ (s (or (gethash server nnatom-servers)
+ (and ; Open the server to add it to `nnatom-servers'
+ (save-match-data
+ (nnatom-open-server
+ server
+ (cdr ; Get defs and backend.
+ (assoc server (cdr (assq 'nnatom nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnatom)
+ (setq server (match-string 3 server))))
+ (gethash server nnatom-servers)))))
+ (g (or (nnatom--group-data group server)
+ `[ ,group ,(make-hash-table :test 'equal)
+ ,(make-hash-table :test 'eql) nil 1 ""])))
+ (puthash new-name g s)
+ (puthash group new-name nnatom-group-names)
+ (remhash group s)
+ (and (string= group nnatom-group)
+ (setq nnatom-group new-name))
+ t))
+
+(gnus-declare-backend (symbol-name nnatom-backend) 'address)
+
+;;;; Utilities:
+
+(defmacro nnatom-define-basic-backend-interface (backend)
+ "Define a basic set of functions and variables for BACKEND."
+ `(progn
+ (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnatom-backend)
+ (defvoo ,(nnoo-symbol backend 'status-string)
+ nil nil nnatom-status-string)
+ (defvoo ,(nnoo-symbol backend 'group) nil nil nnatom-group)
+ (defvoo ,(nnoo-symbol backend 'servers)
+ (make-hash-table :test 'equal) nil nnatom-servers)
+ (defvoo ,(nnoo-symbol backend 'group-article-ids)
+ (make-hash-table :test 'equal) nil nnatom-group-article-ids)
+ (defvoo ,(nnoo-symbol backend 'group-articles)
+ (make-hash-table :test 'eql) nil nnatom-group-articles)
+ (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
+ nnatom-group-article-max-num)
+ (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
+ nnatom-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)
+ (nnatom-open-server server defs ',backend))
+ (nnoo-import ,backend (nnatom))))
+
+(provide 'nnatom)
+
+;;; nnatom.el ends here
--
2.41.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-15 0:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-15 1:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-18 17:32 ` Eric Abrahamsen
2023-07-19 4:37 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2023-07-18 17:32 UTC (permalink / raw)
To: 64202; +Cc: daniel
Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army knife of
text editors" <bug-gnu-emacs@gnu.org> writes:
>>>>>> Eric Abrahamsen writes:
>
> > Where do you see that Gnus knows which backends require an
> > address? That would be very handy.
>
> Forgot to answer this -- 'gnus-valid-select-methods' holds this
> information (and a bunch of other info too).
Huh, I'd forgotten about that. This certainly looks like the right way
to decide whether `gnus-group-make-group' should prompt for an address
or not.
> > But my reading of this function is that we don't even known that
> > the backend is loaded until the end of the group creation
> > process. You could probably mildly abuse the 'request-create-group
> > server function to further prompt the user for the URL.
>
> > It is a bit annoying that the ADDRESS argument is in there, but
> > not prompted for. It looks like that's been the case for at least
> > two decades, though.
>
> I'll add this to the pile of stuff I wanna change in Gnus once I'm
> satisfied with this backend (quite a large pile at this point :).
Careful! Like me, you may end up a casualty of mission creep.
> In any case, I still didn't have much time to work on the backend
> unfortunately, but I attached a patch which incorporates the fixes from
> my last message + changes based on comments from Stefan.
>
> Things left to do:
> 1. Ensure support for none-libxml builds (I should probably figure out
> how ERT works to make this a non-issue going forward).
> 2. Factor out nnfeed.el and base nnatom on top of it (shouldn't be hard).
> 3. Add support for RSS (and steal cool stuff from nnrss).
> 4. Support Atom feeds linked in HTML documents.
Is there a repository somewhere where you're working on this?
Thanks,
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-18 17:32 ` Eric Abrahamsen
@ 2023-07-19 4:37 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-19 15:39 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-07-19 4:37 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 64202
>>>>> Eric Abrahamsen writes:
>> In any case, I still didn't have much time to work on the backend
>> unfortunately, but I attached a patch which incorporates the
>> fixes from my last message + changes based on comments from
>> Stefan.
>>
>> Things left to do: 1. Ensure support for none-libxml builds (I
>> should probably figure out how ERT works to make this a non-issue
>> going forward). 2. Factor out nnfeed.el and base nnatom on top
>> of it (shouldn't be hard). 3. Add support for RSS (and steal
>> cool stuff from nnrss). 4. Support Atom feeds linked in HTML
>> documents.
> Is there a repository somewhere where you're working on this?
I have <git.sr.ht/~dsemy/nnatom>, but I haven't updated it since posting
the first version of the patch, when I started developing it "inside"
the Emacs repo (not sure of the correct terminology).
Honestly, I'm not the best with Git, so I'm not really sure what would
be the best way to do this. Should I just create a mirror (or whatever
its called) of the Emacs repo with my patch applied and work on it from
there?
> Thanks, Eric
Thanks,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-07-19 4:37 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-07-19 15:39 ` Eric Abrahamsen
0 siblings, 0 replies; 62+ messages in thread
From: Eric Abrahamsen @ 2023-07-19 15:39 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
On 07/19/23 07:37 AM, Daniel Semyonov wrote:
>>>>>> Eric Abrahamsen writes:
>
> >> In any case, I still didn't have much time to work on the backend
> >> unfortunately, but I attached a patch which incorporates the
> >> fixes from my last message + changes based on comments from
> >> Stefan.
> >>
> >> Things left to do: 1. Ensure support for none-libxml builds (I
> >> should probably figure out how ERT works to make this a non-issue
> >> going forward). 2. Factor out nnfeed.el and base nnatom on top
> >> of it (shouldn't be hard). 3. Add support for RSS (and steal
> >> cool stuff from nnrss). 4. Support Atom feeds linked in HTML
> >> documents.
>
> > Is there a repository somewhere where you're working on this?
>
> I have <git.sr.ht/~dsemy/nnatom>, but I haven't updated it since posting
> the first version of the patch, when I started developing it "inside"
> the Emacs repo (not sure of the correct terminology).
> Honestly, I'm not the best with Git, so I'm not really sure what would
> be the best way to do this. Should I just create a mirror (or whatever
> its called) of the Emacs repo with my patch applied and work on it from
> there?
It's not a big deal, I just thought if you had an ongoing branch
someplace publicly available I would pull it and follow along. It's a
little harder to see what's changed each time you send a patch as an
attachment, but it's not that important.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-21 7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
` (3 preceding siblings ...)
2023-12-08 3:31 ` Husain Alshehhi
@ 2023-12-08 3:31 ` Husain Alshehhi
[not found] ` <875y1974k0.fsf@>
5 siblings, 0 replies; 62+ messages in thread
From: Husain Alshehhi @ 2023-12-08 3:31 UTC (permalink / raw)
To: 64202; +Cc: daniel
Hi Daniel. Just wondering about the state of this change. Is the atom
method merged in into emacs?
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-06-21 7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
` (2 preceding siblings ...)
2023-06-25 10:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-08 3:31 ` Husain Alshehhi
2023-12-08 3:31 ` Husain Alshehhi
[not found] ` <875y1974k0.fsf@>
5 siblings, 0 replies; 62+ messages in thread
From: Husain Alshehhi @ 2023-12-08 3:31 UTC (permalink / raw)
To: 64202; +Cc: daniel
Hi Daniel. Just wondering about the state of this change. Is the atom
method merged in into emacs?
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
[not found] ` <875y1974k0.fsf@>
@ 2023-12-08 9:32 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-08 16:01 ` Eric Abrahamsen
2023-12-08 16:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 2 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-12-08 9:32 UTC (permalink / raw)
To: Husain Alshehhi; +Cc: 64202
>>>>> Husain Alshehhi writes:
> Hi Daniel. Just wondering about the state of this change. Is the
> atom method merged in into emacs?
I've procrastinated on this for a while and then due to unforeseen
circumstances I've been able to use Emacs on more than my phone only a
few times in the past two months or so. I don't think these
circumstances will change soon, so I'm not sure when I'll be able to
work on this again unfortunately...
FWIW it works in its current state, I'll see if I can find the time to
separate the code between an "nnfeed" backend and nnatom on my phone
(but still I don't want to promise anything), and after that there is no
reason IMO it shouldn't be merged; the backend already supports in
theory the features I still want to add so I should be able to just add
them later (and they aren't required to use the backend or anything).
If anyone feels inclined to do this before me I would be very grateful,
using an Android keyboard for an extended period can get frustrating.
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-08 9:32 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-08 16:01 ` Eric Abrahamsen
2023-12-08 16:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 0 replies; 62+ messages in thread
From: Eric Abrahamsen @ 2023-12-08 16:01 UTC (permalink / raw)
To: 64202; +Cc: husain, daniel
Daniel Semyonov via "Bug reports for GNU Emacs, the Swiss army knife of
text editors" <bug-gnu-emacs@gnu.org> writes:
>>>>>> Husain Alshehhi writes:
>
> > Hi Daniel. Just wondering about the state of this change. Is the
> > atom method merged in into emacs?
>
> I've procrastinated on this for a while and then due to unforeseen
> circumstances I've been able to use Emacs on more than my phone only a
> few times in the past two months or so. I don't think these
> circumstances will change soon, so I'm not sure when I'll be able to
> work on this again unfortunately...
>
> FWIW it works in its current state, I'll see if I can find the time to
> separate the code between an "nnfeed" backend and nnatom on my phone
> (but still I don't want to promise anything), and after that there is no
> reason IMO it shouldn't be merged; the backend already supports in
> theory the features I still want to add so I should be able to just add
> them later (and they aren't required to use the backend or anything).
> If anyone feels inclined to do this before me I would be very grateful,
> using an Android keyboard for an extended period can get frustrating.
Maybe add a roadmap or TODO list to the sourcehut repo, in case anyone
finds time to help out?
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-08 9:32 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-08 16:01 ` Eric Abrahamsen
@ 2023-12-08 16:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-09 11:03 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-12-08 16:26 UTC (permalink / raw)
To: 64202; +Cc: eric, husain
[-- Attachment #1: Type: text/plain, Size: 1265 bytes --]
>>>>> Daniel Semyonov writes:
> I've procrastinated on this for a while and then due to unforeseen
> circumstances I've been able to use Emacs on more than my phone
> only a few times in the past two months or so. I don't think
> these circumstances will change soon, so I'm not sure when I'll be
> able to work on this again unfortunately...
Well as luck would have it I had a rare opportunity to spend a few hours
at home today with no prior business I had to take care of (and this was
also fresh on my mind for a change) so I decided to try finish this
while I could while I can use a normal computer.
Attached is a new version of the patch which is identical in
functionality (more or less) to the last one but nnatom is implemented
on top of an abstract nnfeed backend. I made a lot of effort to
document nnfeed, hopefully everything is clear, but I'm honestly very
tired and might have made some mistakes. The docs in nnfeed.el are
supposed to be all that's needed for someone basing a backend on it, so
I'd like to know if it's clear.
I just realized this patch still can't be merged though, NEWS and the
manual need updated. I'll do it on my phone tomorrow if I have the
time. Hopefully this can be merged soon finally though
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 48167 bytes --]
From dbb989d9584bdefab2470cbe8ef86103e2d263aa Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el:
* lisp/gnus/nnfeed.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom
---
doc/misc/gnus.texi | 58 ++++
etc/NEWS | 7 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 277 ++++++++++++++++++
lisp/gnus/nnfeed.el | 683 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1026 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 586e4b94ba1..6691b0fba7b 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,62 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 the feed specifies a MIME type),
+even base64 encoded files (like images for example), which are
+supported by Atom.
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@item
+Designed with modularity in mind, the back end theoretically supports
+features which aren't available in Atom (and thus aren't actually
+implemented in practice). For example, the back end operates under
+the assumption that ``servers'' (Atom feeds) can have multiple groups,
+when in reality the parsing functions will only ever return servers
+with a single group. In addition, all parsing steps and some of the
+printing is done in functions stored in server variables, to allow
+very easily defining new back ends for different kinds of feeds by
+inheriting from @code{nnatom}; these are called
+@code{nnatom-read-*-function} and
+@code{nnatom-print-content-function}, and their requirements are
+detailed in their docstrings. A macro is provided to ease creation of
+new inheriting backends.
+
+@defmac nnatom-define-basic-backend-interface backend
+Define server variables expected by @code{nnatom} and import its back
+end functions for @var{backend}. This macro (or code similar to it) should
+be used by any inheriting back end.
+@end defmac
+
+@end itemize
+
@node Other Sources
@section Other Sources
diff --git a/etc/NEWS b/etc/NEWS
index 03a40c11c5b..47ecbf3f8e0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -882,6 +882,13 @@ distracting and easily confused with actual code, or a significant
early aid that relieves you from moving the buffer or reaching for the
mouse to consult an error message.
+** Gnus
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
** JS Mode
The binding 'M-.' has been removed from the major mode keymaps in
'js-mode' and 'js-ts-mode', having it default to the global binding
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index 6bf66233101..de5567d1fc0 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1348,6 +1348,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..e92a6f09baa
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,277 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+;; Other types of feeds may be supported by providing custom parsing
+;; functions.
+
+;;; 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)))))
+ (auth (list 'authors)))
+ (when (eq (car data) 'top)
+ (setq data (assq 'feed data)))
+ (dom-add-child-before data auth)
+ (catch :stop ; Collect feed authors, stop at first entry.
+ (dolist (child (cdddr data))
+ (let ((tag (car-safe child)))
+ (if (eq tag 'entry)
+ (throw :stop data)
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child)))))
+ 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 (cddr data)))
+ (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 (string-trim-right
+ (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)))
+ (concat
+ (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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+(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..021fc6bbb32
--- /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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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)
+
+(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 should define all of these functions (ideally).
+;; Apart from this set of variables there is also
+;; `nnfeed-print-content-function' which can be 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').")
+
+(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').")
+
+(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').")
+
+(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').")
+
+(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').")
+
+(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.
+
+(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
+;; 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-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 server))
+ gnus-directory))
+
+(defun nnfeed--read-server (server)
+ "Read SERVER's information 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)))
+
+(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))
+
+;; This is the function which actually uses the functions defined in
+;; the last section. None of those functions are called after parsing
+;; a feed.
+
+(defun nnfeed--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnfeed--server-address feed))
+ (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnfeed-read-feed-function feed group)
+ s (or (gethash feed nnfeed-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (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.")
+
+(defvar nnfeed-date-format "%F %X"
+ "Format of displayed dates (see `format-time-string').")
+
+(nnoo-define-basics nnfeed)
+
+(defun nnfeed--current-server-no-prefix ()
+ "Remove the \"<backend>+\" prefix from the current server."
+ (string-remove-prefix (concat (symbol-name nnfeed-backend) "+")
+ (nnoo-current-server nnfeed-backend)))
+
+(defun nnfeed--group-data (group &optional server)
+ "Get parsed data for GROUP from SERVER (or the current server if omitted)."
+ (let ((s (gethash server nnfeed-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnfeed--current-server-no-prefix))
+ (setq s (gethash c nnfeed-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnfeed-servers)))))
+
+(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 nnfeed-date-format (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 server nnfeed-servers)
+ (nnfeed--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnfeed-group-names)))
+ s))
+ (or s (file-writable-p (nnfeed--server-file a))
+ (and (nnoo-close-server nnfeed-backend server)
+ (nnheader-report
+ nnfeed-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnfeed-request-close ()
+ (maphash (lambda (server _)
+ (nnfeed--write-server
+ (nnfeed--server-address server)))
+ nnfeed-servers)
+ (setq nnfeed-servers (make-hash-table :test 'equal)
+ 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 (or server (nnfeed--current-server-no-prefix)))
+ '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 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)))
+ (s (or (gethash server 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 server (cdr (assq 'nnfeed nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnfeed)
+ (setq server (match-string 3 server))))
+ (gethash server nnfeed-servers)))))
+ (g (or (nnfeed--group-data group server)
+ `[ ,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.43.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-08 16:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-09 11:03 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-09 13:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-12-09 11:03 UTC (permalink / raw)
To: 64202; +Cc: eric, husain
[-- Attachment #1: Type: text/plain, Size: 578 bytes --]
>>>>> Daniel Semyonov writes:
> I just realized this patch still can't be merged though, NEWS and
> the manual need updated. I'll do it on my phone tomorrow if I
> have the time. Hopefully this can be merged soon finally though
I've added a section to the manual documenting nnfeed (without going too
far into implementation details, which are available in the comments and
docstrings of "nnfeed.el"), and amended the the section documenting nnatom.
I've also documented nnfeed in NEWS.
I think this can be merged now. Updated patch attached.
Thanks,
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 49359 bytes --]
From e5707f38277c123a5f13fbc6d55f36247aa85a33 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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/nnatom.el:
* lisp/gnus/nnfeed.el: New file.
* doc/misc/gnus.texi:
* etc/NEWS: Document nnatom and nnfeed.
---
doc/misc/gnus.texi | 74 +++++
etc/NEWS | 10 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 277 ++++++++++++++++++
lisp/gnus/nnfeed.el | 683 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1045 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 586e4b94ba1..e31ab2de557 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
@@ -17250,6 +17251,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
@@ -17494,6 +17496,41 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 the feed specifies a MIME type),
+even base64 encoded files (like images for example), which are
+supported by Atom.
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@end itemize
+
@node Other Sources
@section Other Sources
@@ -29992,6 +30029,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
@@ -30764,6 +30802,42 @@ Mail-like Back Ends
("some-group" (34 . 39)))
@end example
+@node Web Feed Back Ends
+@subsection 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 the Gnus back end interface.
+
+@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 powerful and reasonable 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 03a40c11c5b..7bf73a657ab 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -919,6 +919,16 @@ This keyword enables the user to install packages using 'package-vc'.
** 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 6bf66233101..de5567d1fc0 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1348,6 +1348,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..e92a6f09baa
--- /dev/null
+++ b/lisp/gnus/nnatom.el
@@ -0,0 +1,277 @@
+;;; nnatom.el --- Atom backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+;; Other types of feeds may be supported by providing custom parsing
+;; functions.
+
+;;; 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)))))
+ (auth (list 'authors)))
+ (when (eq (car data) 'top)
+ (setq data (assq 'feed data)))
+ (dom-add-child-before data auth)
+ (catch :stop ; Collect feed authors, stop at first entry.
+ (dolist (child (cdddr data))
+ (let ((tag (car-safe child)))
+ (if (eq tag 'entry)
+ (throw :stop data)
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child)))))
+ 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 (cddr data)))
+ (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 (string-trim-right
+ (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)))
+ (concat
+ (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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+(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..021fc6bbb32
--- /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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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)
+
+(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 should define all of these functions (ideally).
+;; Apart from this set of variables there is also
+;; `nnfeed-print-content-function' which can be 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').")
+
+(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').")
+
+(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').")
+
+(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').")
+
+(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').")
+
+(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.
+
+(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
+;; 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-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 server))
+ gnus-directory))
+
+(defun nnfeed--read-server (server)
+ "Read SERVER's information 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)))
+
+(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))
+
+;; This is the function which actually uses the functions defined in
+;; the last section. None of those functions are called after parsing
+;; a feed.
+
+(defun nnfeed--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnfeed--server-address feed))
+ (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnfeed-read-feed-function feed group)
+ s (or (gethash feed nnfeed-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (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.")
+
+(defvar nnfeed-date-format "%F %X"
+ "Format of displayed dates (see `format-time-string').")
+
+(nnoo-define-basics nnfeed)
+
+(defun nnfeed--current-server-no-prefix ()
+ "Remove the \"<backend>+\" prefix from the current server."
+ (string-remove-prefix (concat (symbol-name nnfeed-backend) "+")
+ (nnoo-current-server nnfeed-backend)))
+
+(defun nnfeed--group-data (group &optional server)
+ "Get parsed data for GROUP from SERVER (or the current server if omitted)."
+ (let ((s (gethash server nnfeed-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnfeed--current-server-no-prefix))
+ (setq s (gethash c nnfeed-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnfeed-servers)))))
+
+(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 nnfeed-date-format (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 server nnfeed-servers)
+ (nnfeed--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnfeed-group-names)))
+ s))
+ (or s (file-writable-p (nnfeed--server-file a))
+ (and (nnoo-close-server nnfeed-backend server)
+ (nnheader-report
+ nnfeed-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnfeed-request-close ()
+ (maphash (lambda (server _)
+ (nnfeed--write-server
+ (nnfeed--server-address server)))
+ nnfeed-servers)
+ (setq nnfeed-servers (make-hash-table :test 'equal)
+ 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 (or server (nnfeed--current-server-no-prefix)))
+ '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 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)))
+ (s (or (gethash server 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 server (cdr (assq 'nnfeed nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnfeed)
+ (setq server (match-string 3 server))))
+ (gethash server nnfeed-servers)))))
+ (g (or (nnfeed--group-data group server)
+ `[ ,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.43.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-09 11:03 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-09 13:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-12 18:08 ` Eric Abrahamsen
2023-12-16 15:14 ` Thomas Fitzsimmons
0 siblings, 2 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-12-09 13:59 UTC (permalink / raw)
To: 64202; +Cc: eric, husain
[-- Attachment #1: Type: text/plain, Size: 227 bytes --]
>>>>> Daniel Semyonov writes:
> I think this can be merged now. Updated patch attached.
Here's another version which fixes a bunch of small mistakes and
clarifies some information in the manual, docstrings and comments.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 50075 bytes --]
From 05bc03d95cb642066eb027edc5cfc4c1b33bdffd Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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 | 73 +++++
etc/NEWS | 10 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 276 ++++++++++++++++++
lisp/gnus/nnfeed.el | 690 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1050 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 586e4b94ba1..4eb283720de 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
@@ -17250,6 +17252,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
@@ -17494,6 +17497,40 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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
@@ -29992,6 +30029,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
@@ -30764,6 +30802,41 @@ Mail-like Back Ends
("some-group" (34 . 39)))
@end example
+@node Web Feed Back Ends
+@subsection 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 03a40c11c5b..7bf73a657ab 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -919,6 +919,16 @@ This keyword enables the user to install packages using 'package-vc'.
** 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 6bf66233101..de5567d1fc0 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1348,6 +1348,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..2fcf59c1441
--- /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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+
+;;; 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)))))
+ (auth (list 'authors)))
+ (when (eq (car data) 'top)
+ (setq data (assq 'feed data)))
+ (dom-add-child-before data auth)
+ (catch :stop ; Collect feed authors, stop at first entry.
+ (dolist (child (cdddr data))
+ (let ((tag (car-safe child)))
+ (if (eq tag 'entry)
+ (throw :stop data)
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child)))))
+ 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 (cddr data)))
+ (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 (string-trim-right
+ (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)))
+ (concat
+ (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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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))
+ parts)
+ ((setq parts (or summary content))
+ `(,(append (or summary content) '(links))))
+ (t '((nil (Content-Type . "text/html") links))))))
+(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..56a447ec1ec
--- /dev/null
+++ b/lisp/gnus/nnfeed.el
@@ -0,0 +1,690 @@
+;;; nnfeed.el --- Generic feed backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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)
+
+(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
+;; 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-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 server))
+ gnus-directory))
+
+(defun nnfeed--read-server (server)
+ "Read SERVER's information 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)))
+
+(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))
+
+;; This is the function which actually uses the functions defined in
+;; the last section. None of those functions are called after parsing
+;; a feed.
+
+(defun nnfeed--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnfeed--server-address feed))
+ (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnfeed-read-feed-function feed group)
+ s (or (gethash feed nnfeed-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (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.")
+
+(defvar nnfeed-date-format "%F %X"
+ "Format of displayed dates (see `format-time-string').")
+
+(nnoo-define-basics nnfeed)
+
+(defun nnfeed--current-server-no-prefix ()
+ "Remove the \"<backend>+\" prefix from the current server."
+ (string-remove-prefix (concat (symbol-name nnfeed-backend) "+")
+ (nnoo-current-server nnfeed-backend)))
+
+(defun nnfeed--group-data (group &optional server)
+ "Get parsed data for GROUP from SERVER (or the current server if omitted)."
+ (let ((s (gethash server nnfeed-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnfeed--current-server-no-prefix))
+ (setq s (gethash c nnfeed-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnfeed-servers)))))
+
+(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 nnfeed-date-format (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 server nnfeed-servers)
+ (nnfeed--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnfeed-group-names)))
+ s))
+ (or s (file-writable-p (nnfeed--server-file a))
+ (and (nnoo-close-server nnfeed-backend server)
+ (nnheader-report
+ nnfeed-backend "Server file %s not readable or writable"
+ server)))))
+
+(deffoo nnfeed-request-close ()
+ (maphash (lambda (server _)
+ (nnfeed--write-server
+ (nnfeed--server-address server)))
+ nnfeed-servers)
+ (setq nnfeed-servers (make-hash-table :test 'equal)
+ 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 (or server (nnfeed--current-server-no-prefix)))
+ '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 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)))
+ (s (or (gethash server 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 server (cdr (assq 'nnfeed nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnfeed)
+ (setq server (match-string 3 server))))
+ (gethash server nnfeed-servers)))))
+ (g (or (nnfeed--group-data group server)
+ `[ ,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.43.0
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-09 13:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-12 18:08 ` Eric Abrahamsen
2023-12-16 15:14 ` Thomas Fitzsimmons
1 sibling, 0 replies; 62+ messages in thread
From: Eric Abrahamsen @ 2023-12-12 18:08 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: husain, 64202
Daniel Semyonov <daniel@dsemy.com> writes:
>>>>>> Daniel Semyonov writes:
>
> > I think this can be merged now. Updated patch attached.
>
> Here's another version which fixes a bunch of small mistakes and
> clarifies some information in the manual, docstrings and comments.
Thanks very much for working on this! I'll need to find a little bit of
time to review, but that will happen in the next week.
Thanks,
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-09 13:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-12 18:08 ` Eric Abrahamsen
@ 2023-12-16 15:14 ` Thomas Fitzsimmons
2023-12-17 0:13 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 62+ messages in thread
From: Thomas Fitzsimmons @ 2023-12-16 15:14 UTC (permalink / raw)
To: 64202; +Cc: eric, husain, daniel
Hi Daniel,
Daniel Semyonov via <bug-gnu-emacs@gnu.org> writes:
>>>>>> Daniel Semyonov writes:
>
> > I think this can be merged now. Updated patch attached.
>
> Here's another version which fixes a bunch of small mistakes and
> clarifies some information in the manual, docstrings and comments.
I am trying this, but am having no luck.
I applied the patch to Emacs master tip
(2a591b228aaa8c66c27cc5b7cb3033aa6625bc0b) and rebuilt.
I am starting from an empty home directory. I customize
gnus-select-method to:
(nnatom "www.fitzsim.org/blog/?feed=atom")
Then M-x gnus RET produces:
nnatom (www.fitzsim.org/blog/?feed=atom) open error: ‘Server file
www.fitzsim.org/blog/?feed=atom not readable or writable’.
Continue? (y or n)
I instead configure gnus-select-method to (nnnil "") and restart Gnus.
Then in the *Group* buffer, I press 'B', then select nnatom, then paste
in:
www.fitzsim.org/blog/?feed=atom
and I see in the minibuffer:
Unable to contact server www.fitzsim.org/blog/?feed=atom: Server
file www.fitzsim.org/blog/?feed=atom not readable or writable
EWW loads both of the following without issue:
https://www.fitzsim.org/blog/?feed=atom
www.fitzsim.org/blog/?feed=atom
Thomas
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-16 15:14 ` Thomas Fitzsimmons
@ 2023-12-17 0:13 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 12:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-12-17 0:13 UTC (permalink / raw)
To: Thomas Fitzsimmons; +Cc: eric, husain, 64202
>>>>> Thomas Fitzsimmons writes:
> Hi Daniel, Daniel Semyonov via <bug-gnu-emacs@gnu.org> writes:
>>>>>>> Daniel Semyonov writes:
>>
>> > I think this can be merged now. Updated patch attached.
>>
>> Here's another version which fixes a bunch of small mistakes and
>> clarifies some information in the manual, docstrings and
>> comments.
> I am trying this, but am having no luck.
> I applied the patch to Emacs master tip
> (2a591b228aaa8c66c27cc5b7cb3033aa6625bc0b) and rebuilt.
> I am starting from an empty home directory. I customize
> gnus-select-method to:
> (nnatom "www.fitzsim.org/blog/?feed=atom")
> Then M-x gnus RET produces:
> nnatom (www.fitzsim.org/blog/?feed=atom) open error: ‘Server
> file www.fitzsim.org/blog/?feed=atom not readable or writable’.
> Continue? (y or n)
> I instead configure gnus-select-method to (nnnil "") and restart
> Gnus. Then in the *Group* buffer, I press 'B', then select
> nnatom, then paste in:
> www.fitzsim.org/blog/?feed=atom
> and I see in the minibuffer:
> Unable to contact server www.fitzsim.org/blog/?feed=atom:
> Server file www.fitzsim.org/blog/?feed=atom not readable or
> writable
> EWW loads both of the following without issue:
> https://www.fitzsim.org/blog/?feed=atom
> www.fitzsim.org/blog/?feed=atom
Huh, I could've sworn I fixed this already.
This happens because you don't have an "atom" subdirectory in your
'gnus-directory'. The backend *should* create it automatically, but
looking at the code it seems I forgot to implement this. If you create
the directory manually it should work. I'll send a patch with a fix as
soon as I can.
Thanks a lot for testing, I really appreciate it.
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-17 0:13 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-17 12:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 15:55 ` Thomas Fitzsimmons
2024-02-02 1:35 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 2 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2023-12-17 12:10 UTC (permalink / raw)
To: Thomas Fitzsimmons; +Cc: eric, husain, 64202
>>>>> Daniel Semyonov writes:
> I'll send a patch with a fix as soon as I can.
I've decided to setup a mirror of the Emacs repo for further
development, so I've pushed the fix there.
It can be found at: https://git.sr.ht/~dsemy/emacs-nnatom.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-17 12:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2023-12-17 15:55 ` Thomas Fitzsimmons
2023-12-17 16:15 ` Eric Abrahamsen
2024-02-02 1:35 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 62+ messages in thread
From: Thomas Fitzsimmons @ 2023-12-17 15:55 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: eric, husain, 64202
Hi Daniel,
Daniel Semyonov <daniel@dsemy.com> writes:
>>>>>> Daniel Semyonov writes:
>
> > I'll send a patch with a fix as soon as I can.
>
> I've decided to setup a mirror of the Emacs repo for further
> development, so I've pushed the fix there.
>
> It can be found at: https://git.sr.ht/~dsemy/emacs-nnatom.
It works now, thank you. I tested my blog's Atom feed. I also reviewed
the patch and it looks good to me, other than "checkdoc" reporting that
`nnatom--read-part' needs a docstring. I think Eric should review it
too before it goes in.
Thomas
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-17 15:55 ` Thomas Fitzsimmons
@ 2023-12-17 16:15 ` Eric Abrahamsen
2023-12-17 20:27 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2023-12-17 16:15 UTC (permalink / raw)
To: Thomas Fitzsimmons; +Cc: husain, 64202, daniel
On 12/17/23 10:55 AM, Thomas Fitzsimmons wrote:
> Hi Daniel,
>
> Daniel Semyonov <daniel@dsemy.com> writes:
>
>>>>>>> Daniel Semyonov writes:
>>
>> > I'll send a patch with a fix as soon as I can.
>>
>> I've decided to setup a mirror of the Emacs repo for further
>> development, so I've pushed the fix there.
>>
>> It can be found at: https://git.sr.ht/~dsemy/emacs-nnatom.
>
> It works now, thank you. I tested my blog's Atom feed. I also reviewed
> the patch and it looks good to me, other than "checkdoc" reporting that
> `nnatom--read-part' needs a docstring. I think Eric should review it
> too before it goes in.
I will soon! Thanks for setting up the mirror, that makes things easier.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-17 16:15 ` Eric Abrahamsen
@ 2023-12-17 20:27 ` Eric Abrahamsen
0 siblings, 0 replies; 62+ messages in thread
From: Eric Abrahamsen @ 2023-12-17 20:27 UTC (permalink / raw)
To: 64202
Eric Abrahamsen <eric@ericabrahamsen.net> writes:
> On 12/17/23 10:55 AM, Thomas Fitzsimmons wrote:
>> Hi Daniel,
>>
>> Daniel Semyonov <daniel@dsemy.com> writes:
>>
>>>>>>>> Daniel Semyonov writes:
>>>
>>> > I'll send a patch with a fix as soon as I can.
>>>
>>> I've decided to setup a mirror of the Emacs repo for further
>>> development, so I've pushed the fix there.
>>>
>>> It can be found at: https://git.sr.ht/~dsemy/emacs-nnatom.
>>
>> It works now, thank you. I tested my blog's Atom feed. I also reviewed
>> the patch and it looks good to me, other than "checkdoc" reporting that
>> `nnatom--read-part' needs a docstring. I think Eric should review it
>> too before it goes in.
>
> I will soon! Thanks for setting up the mirror, that makes things easier.
I just took this for a whirl; so far so good! TBH I forget how nnoo.el
works if I don't look at it for a couple of weeks, so I don't
immediately have any comments there.
In general I prefer using structs instead vectors-as-structs, though
mostly that's for ease of update and change, and if the article vectors
aren't being written to disk as such, maybe it doesn't matter that much.
Something to consider, anyway.
I'll keep trying to break it.
Thanks!
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2023-12-17 12:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 15:55 ` Thomas Fitzsimmons
@ 2024-02-02 1:35 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-04 12:38 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-02 1:35 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
>>>>>> Daniel Semyonov writes:
>
> > I'll send a patch with a fix as soon as I can.
>
> I've decided to setup a mirror of the Emacs repo for further
> development, so I've pushed the fix there.
>
> It can be found at: https://git.sr.ht/~dsemy/emacs-nnatom.
I've been trying it for a few days now, and one thing I notice here is
that the time of the post isn't displayed accurately. For instance, even
if it's 3:30 PM, the summary buffer simply shows 3:30 in my 24-hr clock.
I've no issues other than this. I don't think it's because of my config,
but will check again when I have time.
--
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
2024-02-02 1:35 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-04 12:38 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-07 17:49 ` bug#64202: bug#66188: 29.1; Include Atom feed reader Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-04 12:38 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
>>>>> James Thomas writes:
> I've been trying it for a few days now, and one thing I notice
> here is that the time of the post isn't displayed accurately. For
> instance, even if it's 3:30 PM, the summary buffer simply shows
> 3:30 in my 24-hr clock.
> I've no issues other than this. I don't think it's because of my
> config, but will check again when I have time.
The hour and minutes should be displayed formatted to your 'locale’s
"preferred" time format' (according to `format-time-string's docstring).
I've tested with a few feeds, and this seems to display correctly for me
(with a 24 hour clock).
I the issue is that your locale's "preferred clock" is a 12 hour clock
and I didn't realize that I need to also add "%p" to the format string
to show the locale's version of "AM" or "PM" (or nothing).
I'll push a fix soon.
Thanks for testing,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-04 12:38 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-07 17:49 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-08 4:27 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-07 17:49 UTC (permalink / raw)
To: James Thomas; +Cc: 66188, 64202
>>>>> Daniel Semyonov writes:
> I the issue is that your locale's "preferred clock" is a 12 hour
> clock and I didn't realize that I need to also add "%p" to the
> format string to show the locale's version of "AM" or "PM" (or
> nothing).
> I'll push a fix soon.
I've pushed a commit which turns the displayed date format into a user
option (and fixes the default value, and uses a simple date format when
it isn't displayed).
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-07 17:49 ` bug#64202: bug#66188: 29.1; Include Atom feed reader Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-08 4:27 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-08 11:42 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-08 4:27 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
>>>>>> Daniel Semyonov writes:
>
> > I the issue is that your locale's "preferred clock" is a 12 hour
> > clock and I didn't realize that I need to also add "%p" to the
> > format string to show the locale's version of "AM" or "PM" (or
> > nothing).
>
> > I'll push a fix soon.
>
> I've pushed a commit which turns the displayed date format into a user
> option (and fixes the default value, and uses a simple date format when
> it isn't displayed).
Works now. Thanks!
Another thing: The article numbers seem to be assigned in the reverse
order of datetime on each fetch: ie. the later posts seem to have a
smaller number. Is this intentional?
I'm asking because I use `-sort-by-number' and this kinda messes it up.
I know I can use `-by-date', but still...
Regards,
James
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-08 4:27 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-08 11:42 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 3:54 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-08 11:42 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
>>>>> James Thomas writes:
> Another thing: The article numbers seem to be assigned in the
> reverse order of datetime on each fetch: ie. the later posts seem
> to have a smaller number. Is this intentional?
The articles are numbered based on the order they appear in the feed.
This could be changed, however there is no requirement to place feed
items in a chronological order in Atom (or other feed formats AFAIK), so
this would "fix" this for some feeds while "breaking" it for others.
I think it would be better to just explicitly sort by date in this case.
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-08 11:42 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-09 3:54 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 14:01 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-09 3:54 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
>>>>>> James Thomas writes:
>
> > Another thing: The article numbers seem to be assigned in the
> > reverse order of datetime on each fetch: ie. the later posts seem
> > to have a smaller number. Is this intentional?
>
> The articles are numbered based on the order they appear in the feed.
Of course, but my point was different. Let me try and explain it better
with an example:
Let's say a fetch in the early morning returns these:
6am : Post 1: article number 3
7am : Post 2: article number 2
8am : Post 3: article number 1
(note that the order is reverse)
And a second fetch later on returns these:
9am : Post 4: article number 6
10am: Post 5: article number 5
11am: Post 6: article number 4
When sorting them later on (by number), the order ends up being:
8am : Post 3: article number 1
7am : Post 2: article number 2
6am : Post 1: article number 3
10am: Post 5: article number 5
11am: Post 6: article number 4
9am : Post 4: article number 6
...which is neither descending nor ascending (by time). This could be
fixed if the number generation order (on each fetch) were simply
reversed.
(info "(gnus) Back End Interface") uses the words 'later' and 'order of
arrival'.
WDYT?
> This could be changed, however there is no requirement to place feed
> items in a chronological order in Atom (or other feed formats AFAIK), so
> this would "fix" this for some feeds while "breaking" it for others.
> I think it would be better to just explicitly sort by date in this case.
Regards,
James
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-09 3:54 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-09 14:01 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 20:06 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-09 14:01 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
>>>>> James Thomas writes:
> Daniel Semyonov wrote:
>>>>>>> James Thomas writes:
>>
>> > Another thing: The article numbers seem to be assigned in the
>> > reverse order of datetime on each fetch: ie. the later posts seem
>> > to have a smaller number. Is this intentional?
>>
>> The articles are numbered based on the order they appear in the feed.
> Of course, but my point was different. Let me try and explain it better
> with an example:
Sorry, but I don't understand this example, you seem to be describing
the exact opposite of what should be happening.
> Let's say a fetch in the early morning returns these:
> 6am : Post 1: article number 3
> 7am : Post 2: article number 2
> 8am : Post 3: article number 1
> (note that the order is reverse)
If the 6am post is the first post in the feed, it should get article
number 1 (and the 8am post should get number 3).
> And a second fetch later on returns these:
> 9am : Post 4: article number 6
> 10am: Post 5: article number 5
> 11am: Post 6: article number 4
Same for the 9am post getting article number 4.
> When sorting them later on (by number), the order ends up being:
> 8am : Post 3: article number 1
> 7am : Post 2: article number 2
> 6am : Post 1: article number 3
> 10am: Post 5: article number 5
> 11am: Post 6: article number 4
> 9am : Post 4: article number 6
> ...which is neither descending nor ascending (by time). This could be
> fixed if the number generation order (on each fetch) were simply
> reversed.
If the posts appear in a chronological order, it should end up being
correct. I think what's happening is that the feed you're testing
actually uses a reverse chronological order for posts. If not, send me
the feed, I might be misunderstanding something.
Also there is no "number generation order", the number is just
incremented when a new entry is encountered. You can't know ahead of
time how many new entries you will encounter, so you can't easily
"reverse" this process (it is possible though).
> (info "(gnus) Back End Interface") uses the words 'later' and 'order of
> arrival'.
> WDYT?
I don't think it's really possible to know the order in which entries
arrived in a feed. I've seen feeds with posts in chronological,
reverse-chronological and (seemingly) random orders. Each entry in each
feed might contain a date and an "update" date (in Atom feeds). IME the
relation between these dates and the dates the corresponding posts were
actually published or updated is non-existent.
I still think your best bet is to just sort by date manually.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-09 14:01 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-09 20:06 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 22:34 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-09 20:06 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
>>>>>> James Thomas writes:
>
> > Daniel Semyonov wrote:
> >>>>>>> James Thomas writes:
> >>
> >> > Another thing: The article numbers seem to be assigned in the
> >> > reverse order of datetime on each fetch: ie. the later posts seem
> >> > to have a smaller number. Is this intentional?
> >>
> >> The articles are numbered based on the order they appear in the feed.
>
> > Of course, but my point was different. Let me try and explain it better
> > with an example:
>
> Sorry, but I don't understand this example, you seem to be describing
> the exact opposite of what should be happening.
>
> > Let's say a fetch in the early morning returns these:
>
> > 6am : Post 1: article number 3
> > 7am : Post 2: article number 2
> > 8am : Post 3: article number 1
>
> > (note that the order is reverse)
>
> If the 6am post is the first post in the feed, it should get article
> number 1 (and the 8am post should get number 3).
>
> > And a second fetch later on returns these:
>
> > 9am : Post 4: article number 6
> > 10am: Post 5: article number 5
> > 11am: Post 6: article number 4
>
> Same for the 9am post getting article number 4.
>
> > When sorting them later on (by number), the order ends up being:
>
> > 8am : Post 3: article number 1
> > 7am : Post 2: article number 2
> > 6am : Post 1: article number 3
> > 10am: Post 5: article number 5
> > 11am: Post 6: article number 4
> > 9am : Post 4: article number 6
>
> > ...which is neither descending nor ascending (by time). This could be
> > fixed if the number generation order (on each fetch) were simply
> > reversed.
>
> If the posts appear in a chronological order, it should end up being
> correct. I think what's happening is that the feed you're testing
> actually uses a reverse chronological order for posts. If not, send me
> the feed, I might be misunderstanding something.
Hmm.. It seems to be happening that way for every server I used:
git.savannah.gnu.org/cgit/emacs.git/atom/?h=master
rss.slashdot.org/Slashdot/slashdotMainatom:Slashdot
github.com/emacs-mirror/emacs/commits.atom
(the article numbers are displayed in the Summary buffer modeline)
>
> Also there is no "number generation order", the number is just
> incremented when a new entry is encountered. You can't know ahead of
> time how many new entries you will encounter, so you can't easily
> "reverse" this process (it is possible though).
>
> > (info "(gnus) Back End Interface") uses the words 'later' and 'order of
> > arrival'.
>
> > WDYT?
>
> I don't think it's really possible to know the order in which entries
> arrived in a feed. I've seen feeds with posts in chronological,
> reverse-chronological and (seemingly) random orders. Each entry in each
> feed might contain a date and an "update" date (in Atom feeds). IME the
> relation between these dates and the dates the corresponding posts were
> actually published or updated is non-existent.
> I still think your best bet is to just sort by date manually.
OK. I think I'll use the datetime; for the time being at least.
Regards,
James
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-09 20:06 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-09 22:34 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10 0:15 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-09 22:34 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
>>>>> James Thomas writes:
>> If the posts appear in a chronological order, it should end up
>> being correct. I think what's happening is that the feed you're
>> testing actually uses a reverse chronological order for posts.
>> If not, send me the feed, I might be misunderstanding something.
> Hmm.. It seems to be happening that way for every server I used:
> git.savannah.gnu.org/cgit/emacs.git/atom/?h=master
> rss.slashdot.org/Slashdot/slashdotMainatom:Slashdot
> github.com/emacs-mirror/emacs/commits.atom
These feeds (except for the second one which I can't access) are in
reverse-chronological order.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-09 22:34 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-10 0:15 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-22 2:17 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-10 0:15 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
>>>>>> James Thomas writes:
>
> >> If the posts appear in a chronological order, it should end up
> >> being correct. I think what's happening is that the feed you're
> >> testing actually uses a reverse chronological order for posts.
> >> If not, send me the feed, I might be misunderstanding something.
>
> > Hmm.. It seems to be happening that way for every server I used:
>
> > git.savannah.gnu.org/cgit/emacs.git/atom/?h=master
>
> > rss.slashdot.org/Slashdot/slashdotMainatom:Slashdot
>
> > github.com/emacs-mirror/emacs/commits.atom
>
> These feeds (except for the second one which I can't access) are in
> reverse-chronological order.
Right. I was hoping that that could be made the default.
But I think the patch is fine to be included as it is; from my 1-2 weeks
of testing.
Cheers,
James
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-10 0:15 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-22 2:17 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-22 17:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-22 2:17 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
James Thomas wrote:
> Daniel Semyonov wrote:
>
>>>>>>> James Thomas writes:
>>
>> >> If the posts appear in a chronological order, it should end up
>> >> being correct. I think what's happening is that the feed you're
>> >> testing actually uses a reverse chronological order for posts.
>> >> If not, send me the feed, I might be misunderstanding something.
>>
>> > Hmm.. It seems to be happening that way for every server I used:
>>
>> > git.savannah.gnu.org/cgit/emacs.git/atom/?h=master
>>
>> > rss.slashdot.org/Slashdot/slashdotMainatom:Slashdot
>>
>> > github.com/emacs-mirror/emacs/commits.atom
>>
>> These feeds (except for the second one which I can't access) are in
>> reverse-chronological order.
>
> Right. I was hoping that that could be made the default.
>
> But I think the patch is fine to be included as it is; from my 1-2 weeks
> of testing.
>
> Cheers,
> James
This doesn't seem to work for some feeds such as:
en.wikipedia.org/w/index.php?title=Special:RecentChanges&feed=atom
thehackernews.com/feeds/posts/default
In the first one above, is the colon character to blame?
Another thing: I've been using your branch also with my addition below
for assuming reverse-chronological as a default (Sorry! But it was
really bugging me! :-)).
diff --git a/lisp/gnus/nnatom.el b/lisp/gnus/nnatom.el
index 2fcf59c1441..9f2b9c359aa 100644
--- a/lisp/gnus/nnatom.el
+++ b/lisp/gnus/nnatom.el
@@ -64,14 +64,16 @@ nnatom--read-feed
(when (eq (car data) 'top)
(setq data (assq 'feed data)))
(dom-add-child-before data auth)
- (catch :stop ; Collect feed authors, stop at first entry.
- (dolist (child (cdddr data))
- (let ((tag (car-safe child)))
- (if (eq tag 'entry)
- (throw :stop data)
- (and (or (eq tag 'author)
- (eq tag 'contributor))
- (dom-add-child-before auth child)))))
+ (let ((prev (cddr data)))
+ (while-let ((next (cdr prev))
+ (child (car-safe next))
+ (tag (car-safe child))
+ (_ (not (eq tag 'entry))))
+ (and (or (eq tag 'author)
+ (eq tag 'contributor))
+ (dom-add-child-before auth child))
+ (setq prev next))
+ (setcdr prev (nreverse (cdr prev)))
data)))))))
(defvoo nnatom-read-feed-function #'nnatom--read-feed
nil nnfeed-read-feed-function)
My case for such a change:
- Reverse-chronological makes sense as a default because a feed link
only guarantees to provide the latest updates, not an unbroken chain
of all events since the beginning.
- nnrss.el does it that way: see the 'nreverse' in line #643.
- Performance impact should be minimal because nreverse is O(n) and
perhaps having to sort by date afterward (rather than simply use the
existing number) would more than compensate for that.
- Running -catchup-to-here (on a datetime-sorted Summary buffer) will
only have to record a single article number range in the newsrc.
(My code is probably not as beautiful as many would like it to be)
Would like to know your thoughts.
Regards,
James
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-22 2:17 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-22 17:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-23 16:27 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-22 17:10 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
>>>>> James Thomas writes:
> This doesn't seem to work for some feeds such as:
> en.wikipedia.org/w/index.php?title=Special:RecentChanges&feed=atom
> thehackernews.com/feeds/posts/default
> In the first one above, is the colon character to blame?
Yes. I'm planning to fix this (this is a Gnus limitation), but I have a
a few too many work in progress projects at the moment.
The second feed is an RSS feed.
> Another thing: I've been using your branch also with my addition below
> for assuming reverse-chronological as a default (Sorry! But it was
> really bugging me! :-)).
> <code>
> My case for such a change:
> - Reverse-chronological makes sense as a default because a feed link
> only guarantees to provide the latest updates, not an unbroken chain
> of all events since the beginning.
> - nnrss.el does it that way: see the 'nreverse' in line #643.
> - Performance impact should be minimal because nreverse is O(n) and
> perhaps having to sort by date afterward (rather than simply use the
> existing number) would more than compensate for that.
> - Running -catchup-to-here (on a datetime-sorted Summary buffer) will
> only have to record a single article number range in the newsrc.
> (My code is probably not as beautiful as many would like it to be)
Honestly, your code is much more beautiful than the code it replaces.
> Would like to know your thoughts.
I think your arguments make sense, and you solved the issue in a way I
didn't consider (and is much simpler than what I had in mind).
I'll install this change (probably add a comment explaining the
rationale too, since I was hard to convince) when I get home.
Thanks,
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-22 17:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-23 16:27 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-24 14:49 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-23 16:27 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
>>>>> Daniel Semyonov writes:
> I'll install this change (probably add a comment explaining the
> rationale too, since I was hard to convince) when I get home.
I installed the change and also took the chance to make this function
and a few others more readable.
Please let me know if you have any more suggestions or find more issues.
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-23 16:27 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-24 14:49 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-27 5:02 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-24 14:49 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
>>>>>> Daniel Semyonov writes:
>
> > I'll install this change (probably add a comment explaining the
> > rationale too, since I was hard to convince) when I get home.
>
> I installed the change and also took the chance to make this function
> and a few others more readable.
Thanks!
> Please let me know if you have any more suggestions or find more issues.
Sure thing.
Meanwhile, I think it would be better if you could post the entire
patchset here so that others may test it easily.
Regards,
James
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-24 14:49 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-02-27 5:02 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-03 2:40 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-18 16:58 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 2 replies; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-02-27 5:02 UTC (permalink / raw)
To: James Thomas; +Cc: 64202
[-- Attachment #1: Type: text/plain, Size: 212 bytes --]
>>>>> James Thomas writes:
> Meanwhile, I think it would be better if you could post the entire
> patchset here so that others may test it easily.
Attached. (with all commits squashed into the first)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 50396 bytes --]
From 19c65a1f9dc422f311d39e9d28bea41cf2742e38 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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 | 73 +++++
etc/NEWS | 10 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 276 ++++++++++++++++++
lisp/gnus/nnfeed.el | 696 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1056 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..49a85576a37 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,40 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 +30034,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
@@ -30769,6 +30807,41 @@ Mail-like Back Ends
("some-group" (34 . 39)))
@end example
+@node Web Feed Back Ends
+@subsection 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 b4a1c887f2e..214e0f093d5 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1140,6 +1140,16 @@ This keyword enables the user to install packages using 'package-vc'.
** 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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+
+;;; 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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..c413be5611f
--- /dev/null
+++ b/lisp/gnus/nnfeed.el
@@ -0,0 +1,696 @@
+;;; nnfeed.el --- Generic feed backend for Gnus -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+;; Author: Daniel Semyonov <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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-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 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)))
+
+(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))
+
+;; This is the function which actually uses the functions defined in
+;; the last section. None of those functions are called after parsing
+;; a feed.
+
+(defun nnfeed--parse-feed (feed &optional group)
+ "Parse FEED into a new or existing server.
+Optionally, only parse GROUP."
+ (let* ((feed (nnfeed--server-address feed))
+ (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed)))
+ (g (or (and (hash-table-p s) (gethash group s)) `[,group]))
+ (name group) ; (Maybe) fake name
+ (group (or (aref g 0) name)) ; Real name
+ data)
+ (when (setq data (funcall nnfeed-read-feed-function feed group)
+ s (or (gethash feed nnfeed-servers)
+ (make-hash-table :test 'equal)))
+ (while-let ((cg (or (and name `(,data))
+ (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 \"<backend>+\" prefix from the current server."
+ (string-remove-prefix (concat (symbol-name nnfeed-backend) "+")
+ (nnoo-current-server nnfeed-backend)))
+
+(defun nnfeed--group-data (group &optional server)
+ "Get parsed data for GROUP from SERVER (or the current server if omitted)."
+ (let ((s (gethash server nnfeed-servers)) c)
+ (or (and (hash-table-p s) (gethash group s))
+ (and (setq c (nnfeed--current-server-no-prefix))
+ (setq s (gethash c nnfeed-servers))
+ (hash-table-p s) (gethash group s))
+ (catch :stop (maphash (lambda (n s)
+ (or (string= n server)
+ (string= n c)
+ (when-let (((hash-table-p s))
+ (g (gethash group s)))
+ (throw :stop g))))
+ nnfeed-servers)))))
+
+(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 server nnfeed-servers)
+ (nnfeed--read-server a)))
+ (maphash (lambda (group g)
+ (setq g (aref g 0))
+ (unless (string= group g)
+ (puthash group g nnfeed-group-names)))
+ s))
+ (setq a (nnfeed--server-file a))
+ (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
+ (nnfeed--server-address 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 (or server (nnfeed--current-server-no-prefix)))
+ '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 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)))
+ (s (or (gethash server 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 server (cdr (assq 'nnfeed nnoo-state-alist))
+ (lambda (car key)
+ (and (stringp car)
+ (string-match
+ (concat
+ "\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
+ "\\(" (regexp-quote key) "\\)")
+ car)
+ (setq server car)))))
+ (prog1 (if (stringp (match-string 1 server))
+ (intern (match-string 2 server))
+ 'nnfeed)
+ (setq server (match-string 3 server))))
+ (gethash server nnfeed-servers)))))
+ (g (or (nnfeed--group-data group server)
+ `[ ,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.43.2
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-02-27 5:02 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-03-03 2:40 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-18 16:58 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 0 replies; 62+ messages in thread
From: James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-03 2:40 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: 64202
Daniel Semyonov wrote:
> Attached. (with all commits squashed into the first)
Just FYI: I've posted a patch that gets (info "(gnus) Persistent
Articles") working with this: bug#69517.
Regards,
James
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#66188: 29.1; Include Atom feed reader
2024-02-27 5:02 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-03 2:40 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-03-18 16:58 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-24 13:35 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
1 sibling, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-18 16:58 UTC (permalink / raw)
To: James Thomas; +Cc: Eric Abrahamsen, 66188, 64202
[-- Attachment #1: Type: text/plain, Size: 145 bytes --]
I pushed a few more commits (an updated patch is attached) which fix
some edge cases with ephemeral groups and simplify some functions.
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 49815 bytes --]
From 43f22a60a33536cfcfdec30457123d455d027159 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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 | 73 +++++
etc/NEWS | 10 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 276 ++++++++++++++++++
lisp/gnus/nnfeed.el | 683 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1043 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..49a85576a37 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,40 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 +30034,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
@@ -30769,6 +30807,41 @@ Mail-like Back Ends
("some-group" (34 . 39)))
@end example
+@node Web Feed Back Ends
+@subsection 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 69e61d91b0e..ecf06015829 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1190,6 +1190,16 @@ This keyword enables the user to install packages using 'package-vc'.
** 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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+
+;;; 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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..3a1b22f2a2f
--- /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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 \"<backend>+\" 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 group g 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
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-03-18 16:58 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-03-24 13:35 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-06 9:01 ` bug#66188: " Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-03-24 13:35 UTC (permalink / raw)
To: James Thomas; +Cc: Eric Abrahamsen, 66188, 64202
[-- Attachment #1: Type: text/plain, Size: 428 bytes --]
>>>>> Daniel Semyonov writes:
> I pushed a few more commits (an updated patch is attached) which fix
> some edge cases with ephemeral groups and simplify some functions.
And a few more which fix a typo which caused duplicate groups being
created after renaming a group and relaunching Gnus, and fix the "Web
Feed Back Ends" subsection in the Gnus manual by making it a
subsubsection. Updated patch attached.
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 49796 bytes --]
From ca54f563b9dd03664225639c42b193a29947d391 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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 | 75 +++++
etc/NEWS | 10 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 276 ++++++++++++++++++
lisp/gnus/nnfeed.el | 683 ++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1045 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..7a0e6dd79a3 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,40 @@ 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 (with a single group), as you would with any other
+method, by supplying the location of the feed as the server address.
+Note, however, that the server address shouldn't be prefixed with
+@url{http://} or @url{https://}.
+
+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 +30034,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 +30808,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 19588fe8eeb..552f814ed34 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1220,6 +1220,16 @@ This keyword enables the user to install packages using 'package-vc'.
** 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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+
+;;; 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 \"<backend>+\" 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
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#66188: bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-03-24 13:35 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-06 9:01 ` Eli Zaretskii
2024-04-18 9:01 ` Eli Zaretskii
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-04-06 9:01 UTC (permalink / raw)
To: Daniel Semyonov, eric; +Cc: 66188, 64202, jimjoe
Ping! Eric, any comments about this? Should we install this?
> Cc: Eric Abrahamsen <eric@ericabrahamsen.net>, 66188@debbugs.gnu.org,
> 64202@debbugs.gnu.org
> Date: Sun, 24 Mar 2024 15:35:18 +0200
> From: Daniel Semyonov via "Bug reports for GNU Emacs,
> the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
>
> >>>>> Daniel Semyonov writes:
>
> > I pushed a few more commits (an updated patch is attached) which fix
> > some edge cases with ephemeral groups and simplify some functions.
>
> And a few more which fix a typo which caused duplicate groups being
> created after renaming a group and relaunching Gnus, and fix the "Web
> Feed Back Ends" subsection in the Gnus manual by making it a
> subsubsection. Updated patch attached.
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-04-06 9:01 ` bug#66188: " Eli Zaretskii
@ 2024-04-18 9:01 ` Eli Zaretskii
2024-04-21 0:46 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Eli Zaretskii @ 2024-04-18 9:01 UTC (permalink / raw)
To: eric; +Cc: 66188, 64202, daniel, jimjoe
Ping! Ping! Eric, any comments?
> Cc: 66188@debbugs.gnu.org, 64202@debbugs.gnu.org, jimjoe@gmx.net
> Date: Sat, 06 Apr 2024 12:01:19 +0300
> From: Eli Zaretskii <eliz@gnu.org>
>
> Ping! Eric, any comments about this? Should we install this?
>
> > Cc: Eric Abrahamsen <eric@ericabrahamsen.net>, 66188@debbugs.gnu.org,
> > 64202@debbugs.gnu.org
> > Date: Sun, 24 Mar 2024 15:35:18 +0200
> > From: Daniel Semyonov via "Bug reports for GNU Emacs,
> > the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
> >
> > >>>>> Daniel Semyonov writes:
> >
> > > I pushed a few more commits (an updated patch is attached) which fix
> > > some edge cases with ephemeral groups and simplify some functions.
> >
> > And a few more which fix a typo which caused duplicate groups being
> > created after renaming a group and relaunching Gnus, and fix the "Web
> > Feed Back Ends" subsection in the Gnus manual by making it a
> > subsubsection. Updated patch attached.
>
>
>
>
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#66188: 29.1; Include Atom feed reader
2024-04-18 9:01 ` Eli Zaretskii
@ 2024-04-21 0:46 ` Eric Abrahamsen
2024-04-21 18:41 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2024-04-21 0:46 UTC (permalink / raw)
To: Eli Zaretskii; +Cc: 66188, 64202, daniel, jimjoe
Eli Zaretskii <eliz@gnu.org> writes:
> Ping! Ping! Eric, any comments?
Yes, let's do it! My only comment right now is that the manual should
explicitly list the steps for creating an atom group: "B nnatom RET" and
insert URL without protocol. I still have dreams of fixing the group
creation code to prompt for the address, but that can wait.
Daniel, would you make that addition? Do you have push access to the
Emacs repo?
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#66188: 29.1; Include Atom feed reader
2024-04-21 0:46 ` Eric Abrahamsen
@ 2024-04-21 18:41 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-22 3:11 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-04-21 18:41 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: Eli Zaretskii, jimjoe, 66188, 64202
>>>>> Eric Abrahamsen writes:
> Eli Zaretskii <eliz@gnu.org> writes:
>> Ping! Ping! Eric, any comments?
> Yes, let's do it! My only comment right now is that the manual should
> explicitly list the steps for creating an atom group: "B nnatom RET" and
> insert URL without protocol. I still have dreams of fixing the group
> creation code to prompt for the address, but that can wait.
> Daniel, would you make that addition?
Does the following text (in the 'Atom' subsection of the Gnus manual)
not suffice?
The ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
Gnus servers (with a single group), as you would with any other method,
by supplying the location of the feed as the server address. Note,
however, that the server address shouldn't be prefixed with <http://> or
<https://>.
> Do you have push access to the Emacs repo?
I do not.
Daniel
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#66188: 29.1; Include Atom feed reader
2024-04-21 18:41 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-22 3:11 ` Eric Abrahamsen
2024-04-22 22:44 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2024-04-22 3:11 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: Eli Zaretskii, jimjoe, 66188, 64202
On 04/21/24 21:41 PM, Daniel Semyonov wrote:
>>>>>> Eric Abrahamsen writes:
>
> > Eli Zaretskii <eliz@gnu.org> writes:
> >> Ping! Ping! Eric, any comments?
>
> > Yes, let's do it! My only comment right now is that the manual should
> > explicitly list the steps for creating an atom group: "B nnatom RET" and
> > insert URL without protocol. I still have dreams of fixing the group
> > creation code to prompt for the address, but that can wait.
>
> > Daniel, would you make that addition?
>
> Does the following text (in the 'Atom' subsection of the Gnus manual)
> not suffice?
>
> The ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
> Gnus servers (with a single group), as you would with any other method,
> by supplying the location of the feed as the server address. Note,
> however, that the server address shouldn't be prefixed with <http://> or
> <https://>.
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 suggesting
anything radical, something like:
--8<---------------cut here---------------start------------->8---
The ‘nnatom’ 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 server
address shouldn't be prefixed with <http://> or <https://>.
--8<---------------cut here---------------end--------------->8---
Or something like that. WDYT?
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-04-22 3:11 ` Eric Abrahamsen
@ 2024-04-22 22:44 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-23 14:34 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-04-22 22:44 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: Eli Zaretskii, jimjoe, 66188, 64202
[-- Attachment #1: Type: text/plain, Size: 2663 bytes --]
>>>>> Eric Abrahamsen writes:
> On 04/21/24 21:41 PM, Daniel Semyonov wrote:
>>>>>>> Eric Abrahamsen writes:
>>
>> > Eli Zaretskii <eliz@gnu.org> writes:
>> >> Ping! Ping! Eric, any comments?
>>
>> > Yes, let's do it! My only comment right now is that the manual should
>> > explicitly list the steps for creating an atom group: "B nnatom RET" and
>> > insert URL without protocol. I still have dreams of fixing the group
>> > creation code to prompt for the address, but that can wait.
>>
>> > Daniel, would you make that addition?
>>
>> Does the following text (in the 'Atom' subsection of the Gnus manual)
>> not suffice?
>>
>> The ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
>> Gnus servers (with a single group), as you would with any other method,
>> by supplying the location of the feed as the server address. Note,
>> however, that the server address shouldn't be prefixed with <http://> or
>> <https://>.
> 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 suggesting
> anything radical, something like:
> --8<---------------cut here---------------start------------->8---
> The ‘nnatom’ 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 server
> address shouldn't be prefixed with <http://> or <https://>.
> --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 ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
Gnus servers, by adding them to ‘gnus-secondary-select-methods’ or as
foreign servers by pressing "B" in the ‘*Group*’ 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 <http://> or
<https://>) and each server contains a single group which holds the
feed's entries.
Daniel
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 49898 bytes --]
From 58486c54878ec0496fc5006406a6a3dd4ffae033 Mon Sep 17 00:00:00 2001
From: Daniel Semyonov <daniel@dsemy.com>
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 <http://> or
+<https://>) 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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Gnus backend for HTTP or local feeds following the
+;; Atom Syndication Format <https://www.ietf.org/rfc/rfc4287>.
+
+;;; 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 "<a href=\"%s\">[%s]</a> "
+ 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 <daniel@dsemy.com>
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; 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 \"<backend>+\" 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
^ permalink raw reply related [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-04-22 22:44 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-23 14:34 ` Eric Abrahamsen
2024-04-23 22:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
0 siblings, 1 reply; 62+ messages in thread
From: Eric Abrahamsen @ 2024-04-23 14:34 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: Eli Zaretskii, jimjoe, 66188, 64202
On 04/23/24 01:44 AM, Daniel Semyonov wrote:
>>>>>> Eric Abrahamsen writes:
>
> > On 04/21/24 21:41 PM, Daniel Semyonov wrote:
> >>>>>>> Eric Abrahamsen writes:
> >>
> >> > Eli Zaretskii <eliz@gnu.org> writes:
> >> >> Ping! Ping! Eric, any comments?
> >>
> >> > Yes, let's do it! My only comment right now is that the manual should
> >> > explicitly list the steps for creating an atom group: "B nnatom RET" and
> >> > insert URL without protocol. I still have dreams of fixing the group
> >> > creation code to prompt for the address, but that can wait.
> >>
> >> > Daniel, would you make that addition?
> >>
> >> Does the following text (in the 'Atom' subsection of the Gnus manual)
> >> not suffice?
> >>
> >> The ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
> >> Gnus servers (with a single group), as you would with any other method,
> >> by supplying the location of the feed as the server address. Note,
> >> however, that the server address shouldn't be prefixed with <http://> or
> >> <https://>.
>
> > 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 suggesting
> > anything radical, something like:
>
> > --8<---------------cut here---------------start------------->8---
> > The ‘nnatom’ 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 server
> > address shouldn't be prefixed with <http://> or <https://>.
> > --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 ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
> Gnus servers, by adding them to ‘gnus-secondary-select-methods’ or as
> foreign servers by pressing "B" in the ‘*Group*’ 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 <http://> or
> <https://>) and each server contains a single group which holds the
> feed's entries.
That looks great -- I think it can't hurt to provide some more
hand-holding in the manual. I'll get this in this morning.
Thanks!
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-04-23 14:34 ` Eric Abrahamsen
@ 2024-04-23 22:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-24 14:19 ` Eric Abrahamsen
0 siblings, 1 reply; 62+ messages in thread
From: Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2024-04-23 22:07 UTC (permalink / raw)
To: Eric Abrahamsen; +Cc: 64202, Eli Zaretskii, 66188, jimjoe
>>>>> Eric Abrahamsen writes:
> On 04/23/24 01:44 AM, Daniel Semyonov wrote:
>>>>>>> Eric Abrahamsen writes:
>>
>> > On 04/21/24 21:41 PM, Daniel Semyonov wrote:
>> >>>>>>> Eric Abrahamsen writes:
>> >>
>> >> > Eli Zaretskii <eliz@gnu.org> writes:
>> >> >> Ping! Ping! Eric, any comments?
>> >>
>> >> > Yes, let's do it! My only comment right now is that the manual should
>> >> > explicitly list the steps for creating an atom group: "B nnatom RET" and
>> >> > insert URL without protocol. I still have dreams of fixing the group
>> >> > creation code to prompt for the address, but that can wait.
>> >>
>> >> > Daniel, would you make that addition?
>> >>
>> >> Does the following text (in the 'Atom' subsection of the Gnus manual)
>> >> not suffice?
>> >>
>> >> The ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
>> >> Gnus servers (with a single group), as you would with any other method,
>> >> by supplying the location of the feed as the server address. Note,
>> >> however, that the server address shouldn't be prefixed with <http://> or
>> >> <https://>.
>>
>> > 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 suggesting
>> > anything radical, something like:
>>
>> > --8<---------------cut here---------------start------------->8---
>> > The ‘nnatom’ 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 server
>> > address shouldn't be prefixed with <http://> or <https://>.
>> > --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 ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
>> Gnus servers, by adding them to ‘gnus-secondary-select-methods’ or as
>> foreign servers by pressing "B" in the ‘*Group*’ 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 <http://> or
>> <https://>) and each server contains a single group which holds the
>> feed's entries.
> That looks great -- I think it can't hurt to provide some more
> hand-holding in the manual. I'll get this in this morning.
Great, I just did a git pull and I see it; thank you very much!
Daniel
(BTW I guess this report should be closed; I'm not really sure what the
procedure is since this technically isn't my report, but instead was
merged with mine at some point)
^ permalink raw reply [flat|nested] 62+ messages in thread
* bug#64202: bug#66188: 29.1; Include Atom feed reader
2024-04-23 22:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
@ 2024-04-24 14:19 ` Eric Abrahamsen
0 siblings, 0 replies; 62+ messages in thread
From: Eric Abrahamsen @ 2024-04-24 14:19 UTC (permalink / raw)
To: Daniel Semyonov; +Cc: Eli Zaretskii, 64202-done, 66188-done, jimjoe
On 04/24/24 01:07 AM, Daniel Semyonov wrote:
>>>>>> Eric Abrahamsen writes:
>
> > On 04/23/24 01:44 AM, Daniel Semyonov wrote:
> >>>>>>> Eric Abrahamsen writes:
> >>
> >> > On 04/21/24 21:41 PM, Daniel Semyonov wrote:
> >> >>>>>>> Eric Abrahamsen writes:
> >> >>
> >> >> > Eli Zaretskii <eliz@gnu.org> writes:
> >> >> >> Ping! Ping! Eric, any comments?
> >> >>
> >> >> > Yes, let's do it! My only comment right now is that the manual should
> >> >> > explicitly list the steps for creating an atom group: "B nnatom RET" and
> >> >> > insert URL without protocol. I still have dreams of fixing the group
> >> >> > creation code to prompt for the address, but that can wait.
> >> >>
> >> >> > Daniel, would you make that addition?
> >> >>
> >> >> Does the following text (in the 'Atom' subsection of the Gnus manual)
> >> >> not suffice?
> >> >>
> >> >> The ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
> >> >> Gnus servers (with a single group), as you would with any other method,
> >> >> by supplying the location of the feed as the server address. Note,
> >> >> however, that the server address shouldn't be prefixed with <http://> or
> >> >> <https://>.
> >>
> >> > 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 suggesting
> >> > anything radical, something like:
> >>
> >> > --8<---------------cut here---------------start------------->8---
> >> > The ‘nnatom’ 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 server
> >> > address shouldn't be prefixed with <http://> or <https://>.
> >> > --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 ‘nnatom’ back end allows you to add HTTP or local Atom feeds as
> >> Gnus servers, by adding them to ‘gnus-secondary-select-methods’ or as
> >> foreign servers by pressing "B" in the ‘*Group*’ 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 <http://> or
> >> <https://>) and each server contains a single group which holds the
> >> feed's entries.
>
> > That looks great -- I think it can't hurt to provide some more
> > hand-holding in the manual. I'll get this in this morning.
>
> Great, I just did a git pull and I see it; thank you very much!
>
> Daniel
>
> (BTW I guess this report should be closed; I'm not really sure what the
> procedure is since this technically isn't my report, but instead was
> merged with mine at some point)
Yes, we can close these, if they've been merged then they're the "same"
report. And bug reports aren't precious, if we need another, we can open
another!
Speaking of getting more bug reports, do you want to post on
gnus.general and let people know this new backend is available? It would
be good to get some usage.
Thanks,
Eric
^ permalink raw reply [flat|nested] 62+ messages in thread
end of thread, other threads:[~2024-04-24 14:19 UTC | newest]
Thread overview: 62+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-06-21 7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 13:02 ` Eli Zaretskii
2023-06-21 14:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-25 10:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-26 13:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-26 14:52 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-01 8:39 ` Eli Zaretskii
2023-07-01 11:33 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-02 22:59 ` Eric Abrahamsen
2023-07-03 0:00 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-03 4:01 ` Eric Abrahamsen
2023-07-05 12:36 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-05 17:17 ` Eric Abrahamsen
2023-07-05 18:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-05 19:07 ` Eric Abrahamsen
2023-07-15 0:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-15 1:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-18 17:32 ` Eric Abrahamsen
2023-07-19 4:37 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-19 15:39 ` Eric Abrahamsen
2023-12-08 3:31 ` Husain Alshehhi
2023-12-08 3:31 ` Husain Alshehhi
[not found] ` <875y1974k0.fsf@>
2023-12-08 9:32 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-08 16:01 ` Eric Abrahamsen
2023-12-08 16:26 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-09 11:03 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-09 13:59 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-12 18:08 ` Eric Abrahamsen
2023-12-16 15:14 ` Thomas Fitzsimmons
2023-12-17 0:13 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 12:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 15:55 ` Thomas Fitzsimmons
2023-12-17 16:15 ` Eric Abrahamsen
2023-12-17 20:27 ` Eric Abrahamsen
2024-02-02 1:35 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-04 12:38 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-07 17:49 ` bug#64202: bug#66188: 29.1; Include Atom feed reader Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-08 4:27 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-08 11:42 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 3:54 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 14:01 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 20:06 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 22:34 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10 0:15 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-22 2:17 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-22 17:10 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-23 16:27 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-24 14:49 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-27 5:02 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-03 2:40 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-18 16:58 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-24 13:35 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-06 9:01 ` bug#66188: " Eli Zaretskii
2024-04-18 9:01 ` Eli Zaretskii
2024-04-21 0:46 ` Eric Abrahamsen
2024-04-21 18:41 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-22 3:11 ` Eric Abrahamsen
2024-04-22 22:44 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-23 14:34 ` Eric Abrahamsen
2024-04-23 22:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-24 14:19 ` Eric Abrahamsen
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).