[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1601c5a518d: Gnus: Add back end for Atom feeds (nnatom)
|
From: |
Eric Abrahamsen |
|
Subject: |
master 1601c5a518d: Gnus: Add back end for Atom feeds (nnatom) |
|
Date: |
Tue, 23 Apr 2024 14:20:16 -0400 (EDT) |
branch: master
commit 1601c5a518dfa208af4827c56cf9570f3b90e15d
Author: Daniel Semyonov <daniel@dsemy.com>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>
Gnus: Add back end for Atom feeds (nnatom)
* lisp/gnus/gnus.el (gnus-valid-select-methods): Add entry for nnatom.
* lisp/gnus/nnfeed.el: New file implementing an abstract web feed back
end.
* lisp/gnus/nnatom.el: New file implementing a back end for Atom feeds.
* doc/misc/gnus.texi (Browsing the Web, Back End Interface):
* etc/NEWS (Gnus): Document nnatom and nnfeed.
---
doc/misc/gnus.texi | 77 ++++++
etc/NEWS | 10 +
lisp/gnus/gnus.el | 1 +
lisp/gnus/nnatom.el | 276 +++++++++++++++++++++
lisp/gnus/nnfeed.el | 683 ++++++++++++++++++++++++++++++++++++++++++++++++++++
5 files changed, 1047 insertions(+)
diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi
index 419a5390374..8aa7f855aea 100644
--- a/doc/misc/gnus.texi
+++ b/doc/misc/gnus.texi
@@ -715,6 +715,7 @@ Browsing the Web
* 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 @@ 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.
Various File Formats
@@ -17252,6 +17254,7 @@ interfaces to these sources.
@menu
* Web Searches:: Creating groups from articles that match a
string.
* RSS:: Reading RDF site summary.
+* Atom:: Reading Atom Syndication Format feeds.
@end menu
The main caveat with all these web sources is that they probably won't
@@ -17496,6 +17499,42 @@ Parameters}) in order to display @samp{text/html}
parts only in
@end lisp
+@node Atom
+@subsection Atom
+@cindex nnatom
+@cindex Atom
+
+Some web sites provide an Atom Syndication Format feed. Atom is a web
+feed format similar in function to RDF Site Summary (@pxref{RSS}).
+
+The @code{nnatom} back end allows you to add HTTP or local Atom feeds as
+Gnus servers, by adding them to @code{gnus-secondary-select-methods} or
+as foreign servers by pressing "B" in the @file{*Group*} buffer, for
+example (@pxref{Finding the News}). The address of each server is its
+feed's location (though the address shouldn't be prefixed with <http://> or
+<https://>) and each server contains a single group which holds the
+feed's entries.
+
+Features of @code{nnatom} include:
+
+@itemize @bullet
+
+@item
+Server data is saved per-server in the @file{atom} sub-directory of
+@file{gnus-directory}.
+
+@item
+An article part is generated for both the summary and the content for
+each entry in the feed. Content of all MIME types should be displayed
+correctly through Gnus (as long as they are supported and the feed
+specifies a MIME type).
+
+@item
+Article modification and publish dates are tracked, and articles are
+updated if changed.
+
+@end itemize
+
@node Other Sources
@section Other Sources
@@ -29997,6 +30036,7 @@ In the examples and definitions I will refer to the
imaginary back end
* Writing New Back Ends:: Extending old back ends.
* Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end.
* Mail-like Back Ends:: Some tips on mail back ends.
+* Web Feed Back Ends:: Easily defining back ends for web feeds.
@end menu
@@ -30770,6 +30810,43 @@ this:
@end example
+@node Web Feed Back Ends
+@subsubsection Web Feed Back Ends
+
+If you want to write a back end for a new type of web feed (RSS,
+Atom), or some other type of feed, an ``abstract'' back end
+(@code{nnfeed}) exists to enable the creation of such back ends with
+minimal knowledge of Gnus.
+
+@code{nnfeed} defines a generic parser, which uses functions stored in
+server variables to parse information from a feed (@code{nnfeed}
+itself doesn't actually define any such functions though).
+
+The data parsed from the feed is stored in server variables (and
+stored per-feed in a sub-directory of @option{gnus-directory} whose name
+corresponds to the name of the back end).
+
+A Gnus back end interface is also defined, which uses the data parsed
+from the feed.
+
+Therefore, a new back end only needs to inherit from @code{nnfeed},
+define (fairly) generic parsing functions for the feed type and setup
+the required server variables.
+
+@code{nnfeed} was originally created to support Atom Syndication
+Format feeds (@pxref{Atom}), but is very generic (as of writing this,
+no standard web feed exists which can meaningfully use all the
+features supported): it supports multiple groups contained in a single
+feed, it allows for situations when the entire feed can't (or
+shouldn't) be read ahead of time and it allows for very advanced
+customization of the actual printing of articles from parsed data
+(while providing a reasonably powerful default method).
+
+Further implementation details are available in the documentation
+strings of the various @code{nnfeed-*} server variables and
+the commentary and other comments of @file{nnfeed.el}.
+
+
@node Score File Syntax
@subsection Score File Syntax
diff --git a/etc/NEWS b/etc/NEWS
index 82c73f7416b..fea27bb8a31 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1337,6 +1337,16 @@ when using the ':vc' keyword.
** Gnus
++++
+*** New back end 'nnfeed'.
+This allows back end developers to easily create new back ends for web
+feeds, as inheriting back ends of 'nnfeed'.
+
++++
+*** New back end 'nnatom'.
+This allow users to add Atom Syndication Format feeds to Gnus as
+servers.
+
*** The 'nnweb-type' option 'gmane' has been removed.
The gmane.org website is, sadly, down since a number of years with no
prospect of it coming back. Therefore, it is no longer valid to set
diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el
index dab66b60205..bc8819dc967 100644
--- a/lisp/gnus/gnus.el
+++ b/lisp/gnus/gnus.el
@@ -1360,6 +1360,7 @@ slower."
("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
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 1601c5a518d: Gnus: Add back end for Atom feeds (nnatom),
Eric Abrahamsen <=