unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom)
@ 2023-06-21  7:08 Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
  2023-06-21  9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
                   ` (5 more replies)
  0 siblings, 6 replies; 64+ 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] 64+ messages in thread
* 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; 64+ 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] 64+ messages in thread
end of thread, other threads:[~2024-04-24 14:19 UTC | newest]

Thread overview: 64+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-06-21  7:08 bug#64202: [PATCH] Gnus: Add back end for Atom feeds (nnatom) Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21  9:50 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-21 13:02 ` Eli Zaretskii
2023-06-21 14:26   ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-25 10:07 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-26 13:26   ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-06-26 14:52     ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-01  8:39       ` Eli Zaretskii
2023-07-01 11:33         ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-02 22:59           ` Eric Abrahamsen
2023-07-03  0:00             ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-03  4:01               ` Eric Abrahamsen
2023-07-05 12:36                 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-05 17:17                   ` Eric Abrahamsen
2023-07-05 18:50                     ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-05 19:07                       ` Eric Abrahamsen
2023-07-15  0:59                         ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-15  1:26                           ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-18 17:32                           ` Eric Abrahamsen
2023-07-19  4:37                             ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-19 15:39                               ` Eric Abrahamsen
2023-12-08  3:31 ` Husain Alshehhi
2023-12-08  3:31 ` Husain Alshehhi
     [not found] ` <875y1974k0.fsf@>
2023-12-08  9:32   ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-08 16:01     ` Eric Abrahamsen
2023-12-08 16:26     ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-09 11:03       ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-09 13:59         ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-12 18:08           ` Eric Abrahamsen
2023-12-16 15:14           ` Thomas Fitzsimmons
2023-12-17  0:13             ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 12:10               ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-12-17 15:55                 ` Thomas Fitzsimmons
2023-12-17 16:15                   ` Eric Abrahamsen
2023-12-17 20:27                     ` Eric Abrahamsen
2024-02-02  1:35                 ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-04 12:38                   ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-07 17:49                     ` bug#64202: bug#66188: 29.1; Include Atom feed reader Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-08  4:27                       ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-08 11:42                         ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09  3:54                           ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 14:01                             ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 20:06                               ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-09 22:34                                 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-10  0:15                                   ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-22  2:17                                     ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-22 17:10                                       ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-23 16:27                                         ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-24 14:49                                           ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-02-27  5:02                                             ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-03  2:40                                               ` James Thomas via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-18 16:58                                               ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-03-24 13:35                                                 ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-06  9:01                                                   ` bug#66188: " Eli Zaretskii
2024-04-18  9:01                                                     ` Eli Zaretskii
2024-04-21  0:46                                                       ` Eric Abrahamsen
2024-04-21 18:41                                                         ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-22  3:11                                                           ` Eric Abrahamsen
2024-04-22 22:44                                                             ` bug#64202: " Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-23 14:34                                                               ` Eric Abrahamsen
2024-04-23 22:07                                                                 ` Daniel Semyonov via Bug reports for GNU Emacs, the Swiss army knife of text editors
2024-04-24 14:19                                                                   ` Eric Abrahamsen
  -- strict thread matches above, loose matches on Subject: below --
2023-09-24 18:40 Daniel Cerqueira
2023-09-25  9:22 ` Stefan Kangas

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).