procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Gnus: Add back end for Atom feeds (nnatom)

Browse source 
* 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.
This commit is contained in:
Daniel Semyonov 2023-06-21 10:05:04 +03:00 • committed by Eric Abrahamsen
parent 94ed2df02f
commit 1601c5a518
5 changed files with 1047 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
doc/misc/gnus.texi
View file

@ -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

10
etc/NEWS
View file

@ -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

1
lisp/gnus/gnus.el
View file

@ -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

276
lisp/gnus/nnatom.el Normal file
View file

@ -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

683
lisp/gnus/nnfeed.el Normal file
View file

@ -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