;;; org-webring.el --- Static RSS/ATOM webring generator for org-mode
;; Copyright (C) 2020 Brett Gilio
;; Copyright (C) 2020 Alexandru-Sergiu Marton
;; Copyright (C) 2020 Jamie Beardslee
;; Copyright (C) 2020 Amin Bandali
;; Copyright (C) 2020 Ivan Sokolov
;; Author: Brett Gilio <brettg@gnu.org>
;; Co-author: Alexandru-Sergiu Marton <brown121407@posteo.ro>
;; Co-author: Jamie Beardslee <jdb@jamzattack.xyz>
;; Co-author: Amin Bandali <bandali@gnu.org>
;; Co-author: Ivan Sokolov <ivan-p-sokolov@ya.ru>
;; Version: 1.9.1
;; Homepage: https://sr.ht/~brettgilio/org-webring
;; Repository: https://git.sr.ht/~brettgilio/org-webring
;; Tracker: https://todo.sr.ht/~brettgilio/org-webring
;; Mailing List: https://lists.sr.ht/~brettgilio/org-webring
;; Package-Requires: ((emacs "25.1") (xmlgen "0.5"))
;; This file is not currently part of GNU Emacs.
;; This program 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, or (at
;; your option) any later version.
;; This program 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.
;;; Commentary:
;; `org-webring' is an alternative implementation of a feed-based
;; webring, taking inspiration from `openring' by Drew DeVault.
;; Intended to integrate with Org-based websites and blogs (either
;; directly, or indirectly, as in ox-hugo), it will fetch a given list
;; of web-feed files and correctly parse and format the elements to be
;; displayed for sharing.
;; The CSS file `org-webring.css' needs to be loaded by your website,
;; and your browser must be able to render flex boxes. This file is
;; provides stylization support for both the `webring' and `planet'
;; functionality.
;; The files `ring.org' and `planet.org' are templates. Copy one
;; or both of them into a specified directory from where your website
;; is generated. Add all relevant web-feed URLs to `org-webring-urls'
;; for fetching, and adjust variables as desired.
;; To include the results of `ring.org' into an Org file export of
;; your choosing, simply add: "#+INCLUDE: ./ring.org", taking care to
;; modify the path appropriately. When you regenerate your Org-based
;; (or Hugo, using ox-hugo) website, the function
;; `org-webring-generate-webring' will be evaluated and the result
;; will be displayed.
;; Additionally, if you are using the `planet.org' file, simply have
;; the `org-publish' functionality of your choosing convert the file
;; to HTML and serve it as you would any other page. This page is
;; designated standalone, and probably should not be included in
;; other Org-mode files. The result is produced by the
;; `org-webring-generate-planet' function.
;;; Code:
(require 'cl-lib)
(require 'dom)
(require 'org)
(require 'seq)
(require 'url)
(require 'xml)
(require 'xmlgen)
(defconst org-webring-attribution-name
"org-webring"
"The name of the program used for generation.")
(defconst org-webring-attribution-link
"https://sr.ht/~brettgilio/org-webring"
"Address of the project-hub page.")
(defconst org-webring-version
"1.9.1"
"The current version of `org-webring'.")
(defcustom org-webring-items-total 3
"The total number of items displayed on the webring."
:group 'org-webring
:type 'integer)
(defcustom org-webring-items-per-source 1
"The number of entries extracted from each source."
:group 'org-webring
:type 'integer)
(defcustom org-webring-header "Posts from other blogs I follow..."
"The default text displayed in the header."
:group 'org-webring
:type 'string)
(defcustom org-webring-display-header t
"Display the result of `org-webring-header'.
When set to non-NIL, the generator will display the value
set for the header."
:group 'org-webring
:type 'bool)
(defcustom org-webring-urls '()
"The source URLs which are scraped for feeds."
:group 'org-webring
:type '(repeat string))
(defcustom org-webring-summary-max-length 512
"The maximum number of characters displayed in the summary field."
:group 'org-webring
:type 'integer)
(defcustom org-webring-timestamp-feed-format "%a, %d %b %Y"
"The string format used for the publication dates of feed items.
This variable uses the same '%'-sequences as `format-time-string'."
:group 'org-webring
:type 'string)
(defcustom org-webring-timestamp-generate-format "%a, %d %b %Y -- %R"
"The string format used for the generation of the webring or planet.
This variable uses the same '%'-sequences as `format-time-string'."
:group 'org-webring
:type 'string)
(defcustom org-webring-display-generation-time t
"Display the result of `org-webring-timestamp-generate-format'.
When set to non-NIL, the generator will display the most recent
generation time of `org-webring'."
:group 'org-webring
:type 'bool)
(defcustom org-webring-display-attribution t
"Display the software attribution under the webring or planet.
When set to non-NIL, the generator will display the name of
the program used to generate the webring or planet."
:group 'org-webring
:type 'bool)
(defcustom org-webring-display-version t
"Display the current version of `org-webring'.
When set to non-NIL, the generator will display the current
version of `org-webring'."
:group 'org-webring
:type 'bool)
(defcustom org-webring-empty-summary "No summary available."
"Text that will be displayed when the post summary returns
an empty string."
:group 'org-webring
:type 'string)
(defcustom org-webring-planet-items-total 50
"The total number of items generated by the planet."
:group 'org-webring
:type 'integer)
(defcustom org-webring-planet-display-description t
"When set to non-NIL, the generator will display the value
set for the planet description."
:group 'org-webring
:type 'bool)
(defcustom org-webring-planet-description "<Default planet description.>"
"Text of the planet description."
:group 'org-webring
:type 'string)
(defcustom org-webring-pinned-urls '()
"A list of feed items that should be pinned."
:group 'org-webring
:type '(repeat string))
(defcustom org-webring-pin-symbol "🖈"
"The symbol used to denote a pinned item."
:group 'org-webring
:type 'string)
(defun org-webring--xml-get-child (xml child-name)
"Return the first child of the parsed XML root whose name
matches CHILD-NAME."
(car (xml-get-children xml child-name)))
(defun org-webring--xml-node-text (xml)
"Extract the text from a parsed XML node."
(caddr xml))
(defun org-webring--feed-text-prop (feed prop)
"Return the text of the PROP child of FEED, which is a parsed
XML node."
(org-webring--xml-node-text
(org-webring--xml-get-child feed prop)))
(defun org-webring--type (feed)
"Determine whether FEED is an RSS or Atom feed.
FEED must alread be parsed.
Return `rss' if it is an RSS feed, and `atom' if it is an
Atom feed."
(if (assoc 'rss feed)
'rss
'atom))
(defun org-webring--feed-items (feed type)
"Extract only the items of a parsed FEED.
Return the `item' tag if TYPE is `rss', otherwise return the
`entry' tag."
(xml-get-children feed (if (eq 'rss type)
'item
'entry)))
(defun org-webring--feed-parse (data type)
"Parse DATA and return the content.
If TYPE is `rss', return the `channel' tag, otherwise return the
`feed' tag."
(if (eq type 'rss)
(assq 'channel
(assq 'rss data))
(assq 'feed data)))
(defun org-webring--get-link (object)
"Return the source link of OBJECT.
OBJECT may be either the full feed or an item thereof."
(or (org-webring--feed-text-prop object 'link)
(cdr
(assoc 'href
(seq-find (lambda (attributes)
(let ((rel (cdr (assoc 'rel attributes))))
(or (string-equal rel "alternate")
(null rel))))
(seq-map #'cadr
(xml-get-children object 'link)))))))
(defun org-webring--partition-list (predicate list)
"Split LIST based on PREDICATE.
The first value returned contains the elements that satisfy
PREDICATE, and the second contains those that do not."
(cl-loop for x in list
if (funcall predicate x) collect x into satisfy
else collect x into fail
finally (return (cl-values satisfy fail))))
(defun org-webring--get-items-from-url (url)
"Create a list of items contained in the feed at URL.
Produces the value set by `org-webring-items-per-source'."
(let* ((url-content
(with-temp-buffer
(url-insert-file-contents url)
(condition-case msg
(xml-parse-region)
(error
(read-event
(format
"Warning: \"%s\"
URL: %s
The URL will be skipped
--> Press any key to continue or C-g to QUIT."
(cadr msg) url))
nil))))
(type (org-webring--type url-content))
(feed (org-webring--feed-parse url-content type))
(rss<>atom-feed url)
(source-link (org-webring--get-link feed))
(source-title (org-webring--feed-text-prop feed 'title)))
(seq-map (lambda (item)
`(item ; tag
nil ; class
;; children
(sourceFeed nil ,rss<>atom-feed)
(sourceType nil ,type)
(sourceLink nil ,source-link)
(sourceTitle nil ,source-title)
(pinned nil ,(if (member (org-webring--get-link item) org-webring-pinned-urls)
'true
'false))
,@(xml-node-children item)))
(seq-take
(cl-multiple-value-bind (pinned normal)
(org-webring--partition-list
(lambda (item)
(member (org-webring--get-link item) org-webring-pinned-urls))
(org-webring--feed-items feed type))
(append pinned normal))
org-webring-items-per-source))))
(defun org-webring--item-pinned-p (item)
"Check if ITEM item is pinned, and return it if TRUE."
(eq (org-webring--feed-text-prop item 'pinned)
'true))
(defun org-webring--string-truncate (len s elipsis)
"If S is longer than LEN, cut it down and add ELIPSIS at the
end. Taken from the s.el library."
(if (> (length s) len)
(format "%s%s" (substring s 0 (- len (length elipsis))) elipsis)
s))
(defun org-webring--parse-datetime (datetime atom-p)
"Convert string DATETIME to a list of components.
ATOM-P enables `iso8601.el' parsing or will fallback."
(if (not atom-p)
(parse-time-string datetime)
;; This check is unnecessary for Emacs 28, but in Emacs 27
;; `parse-time-string' does not yet understand ISO8601.
;; XXX: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=43175
(if (require 'iso8601 nil t)
(iso8601-parse datetime)
;; Fallback for Emacs 26.3 and earlier
(thread-first datetime
(substring 0 19)
(split-string "T")
(string-join " ")
(concat " +0000")
(parse-time-string)))))
(defun org-webring--date->time (date &optional atom-p)
"Convert DATE string to a time value.
Rudimentary support for parsing ISO-8601 time strings is used
when ATOM-P is non-NIL and the function `iso8601-parse' (which
was introduced in Emacs 27) isn't available."
(apply #'encode-time (org-webring--parse-datetime date atom-p)))
(defun org-webring--pub-time (item)
"Get ITEM's publication time."
(let ((atom-p (not (xml-get-children item 'pubDate))))
(org-webring--date->time
(or (org-webring--feed-text-prop item 'pubDate)
(org-webring--feed-text-prop item 'updated))
atom-p)))
(defun org-webring--article-instance (item)
"Generate the structure of a feed article from a given ITEM."
(let ((desc-sanitized
(let ((content
(or (org-webring--feed-text-prop item 'description)
(org-webring--feed-text-prop item 'content)
(org-webring--feed-text-prop item 'summary))))
(apply #'concat
(dom-strings
(cond ((stringp content)
(with-temp-buffer
(insert content)
(libxml-parse-html-region (point-min)
(point-max))))
((consp content)
content)))))))
`(div :class ,(concat "org-webring-article"
(if (org-webring--item-pinned-p item)
"-pinned"
nil))
,@(when (org-webring--item-pinned-p item)
`((div :class "org-webring-article-pinned-symbol"
,org-webring-pin-symbol)))
(h4 :class "org-webring-article-title"
(a :href ,(org-webring--get-link item)
:target "_blank"
,(org-webring--feed-text-prop item 'title)))
(p :class "org-webring-article-summary"
,(org-webring--string-truncate
org-webring-summary-max-length
(if (zerop (length desc-sanitized))
`(i ,(print org-webring-empty-summary))
desc-sanitized)
"…"))
(small :class "org-webring-article-source"
(a :href
,(org-webring--feed-text-prop item 'sourceLink)
:target "_blank"
,(org-webring--feed-text-prop item 'sourceTitle)))
(small :class "org-webring-article-date"
(span :class "org-webring-timestamp"
,(format-time-string org-webring-timestamp-feed-format
(org-webring--pub-time item)
"GMT"))))))
(defun org-webring--construct-syndicate (item)
"Generate the structure of a feed article from a given ITEM."
(let ((org-webring-items-per-source 1))
`(small (li (a :href
,(org-webring--feed-text-prop item 'sourceLink)
:target "_blank"
,(org-webring--feed-text-prop item 'sourceTitle))
,(print " - [")
(a :href
,(org-webring--feed-text-prop item 'sourceFeed)
:target "_blank"
:class "org-webring-feed-url"
,(symbol-name
(org-webring--feed-text-prop item 'sourceType)))
,(print "]")))))
(defun org-webring-generate-webring ()
"Generate the entire webring and return it as HTML."
(let* ((unique-urls (seq-uniq org-webring-urls))
(items (mapcan #'org-webring--get-items-from-url unique-urls))
(articles
(cl-multiple-value-bind (pinned normal)
(org-webring--partition-list
#'org-webring--item-pinned-p
items)
(let* ((combined-items (list pinned normal))
(sorted-items (mapcar (lambda (items)
(cl-sort items #'time-less-p
:key #'org-webring--pub-time))
combined-items))
(most-recent (mapcar (lambda (x)
(reverse (last x org-webring-items-total)))
sorted-items))
(articles (mapcar #'org-webring--article-instance
(seq-take (apply #'append most-recent) org-webring-items-total))))
articles))))
(xmlgen
`(section :class "org-webring"
,@(when org-webring-display-header
`((h4 ,(print org-webring-header))))
(section :class "org-webring-articles" ,@articles)
(p :class "org-webring-attribution"
,@(when org-webring-display-generation-time
(list
`(span :class "org-webring-timestamp"
,(format-time-string
org-webring-timestamp-generate-format))
`(br)))
,@(when org-webring-display-attribution
`(,(print "Generated with ")
(a :href ,org-webring-attribution-link
:target "_blank"
,org-webring-attribution-name)
,@(when org-webring-display-version
(list (print (concat " -- v"
org-webring-version)))))))))))
(defun org-webring-generate-planet ()
"Generate the entire planet with syndicates list and return it as HTML."
(let* ((org-webring-items-per-source most-positive-fixnum)
(unique-urls (seq-uniq org-webring-urls))
(items (mapcan #'org-webring--get-items-from-url unique-urls))
(sorted-items (cl-sort items #'time-less-p
:key #'org-webring--pub-time))
(most-recent (reverse (last sorted-items
org-webring-planet-items-total)))
(articles (mapcar #'org-webring--article-instance most-recent)))
(xmlgen
`(section :class "org-webring-planet"
,@(when org-webring-planet-display-description
`((h4 (center ,(print org-webring-planet-description)))))
(p :class "org-webring-attribution"
,@(when org-webring-display-generation-time
(list
`(span :class "org-webring-timestamp"
,(format-time-string
org-webring-timestamp-generate-format))
`(br)))
,@(when org-webring-display-attribution
`(,(print "Generated with ")
(a :href ,org-webring-attribution-link
:target "_blank"
,org-webring-attribution-name)
,@(when org-webring-display-version
(list (print (concat " -- v"
org-webring-version))))))
(hr))
(div :class "row"
,(let* ((org-webring-items-per-source 1)
(syndicate-items
(mapcan #'org-webring--get-items-from-url
unique-urls))
(syndicates
(mapcar #'org-webring--construct-syndicate
syndicate-items)))
`(div :class "column-right"
(p (h5 ,(print "Syndicates"))
,@syndicates)))
(div :class "column-left"
(section :class "org-webring-articles"
,@articles)))))))
(defun org-webring-version ()
"Return a message to the echo area displaying the current
version of `org-webring'."
(interactive)
(message org-webring-version))
(provide 'org-webring)
;;; org-webring.el ends here