* bug#66188: 29.1; Include Atom feed reader @ 2023-09-24 18:40 Daniel Cerqueira 2023-09-25 9:22 ` Stefan Kangas 0 siblings, 1 reply; 6+ messages in thread From: Daniel Cerqueira @ 2023-09-24 18:40 UTC (permalink / raw) To: 66188 Gnus has support to read RSS feeds. Can you guys add support to also read Atom feeds in Gnus? May import some code from elfeed.el on this year's Hackoberfest? Thanks :-) ^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#66188: 29.1; Include Atom feed reader 2023-09-24 18:40 bug#66188: 29.1; Include Atom feed reader Daniel Cerqueira @ 2023-09-25 9:22 ` Stefan Kangas 0 siblings, 0 replies; 6+ messages in thread From: Stefan Kangas @ 2023-09-25 9:22 UTC (permalink / raw) To: Daniel Cerqueira; +Cc: 66188 forcemerge 64202 66188 thanks Daniel Cerqueira <dan.list@brilhante.top> writes: > Gnus has support to read RSS feeds. Can you guys add support to also > read Atom feeds in Gnus? > > May import some code from elfeed.el on this year's Hackoberfest? > > Thanks :-) This is a duplicate of Bug#64202, so I'm merging them. ^ permalink raw reply [flat|nested] 6+ messages in thread
* 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-12-09 11:03 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 6+ 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] 6+ 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 0 siblings, 1 reply; 6+ 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] 6+ 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-16 15:14 ` Thomas Fitzsimmons 0 siblings, 1 reply; 6+ 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] 6+ 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-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 0 siblings, 1 reply; 6+ 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] 6+ 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; 6+ 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] 6+ 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 2024-02-02 1:35 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 6+ 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] 6+ 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 @ 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 0 siblings, 1 reply; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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-18 16:58 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 1 reply; 6+ 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] 6+ 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-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 0 siblings, 1 reply; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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; 6+ 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] 6+ 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 0 siblings, 0 replies; 6+ 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] 6+ messages in thread
end of thread, other threads:[~2024-04-22 3:11 UTC | newest] Thread overview: 6+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2023-09-24 18:40 bug#66188: 29.1; Include Atom feed reader Daniel Cerqueira 2023-09-25 9:22 ` Stefan Kangas -- strict thread matches above, loose matches on Subject: below -- 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-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-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 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-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
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.