X-Git-Url: https://gitweb.fperrin.net/?p=atom.el.git;a=blobdiff_plain;f=atom.el;h=c4224b85680ae273b942936da6236319ce99bd89;hp=0a4b61e53318a0d53848c827175b1fba0c08d848;hb=HEAD;hpb=e1b9724b572b85b05aba7bcc9217c4aab8378edd diff --git a/atom.el b/atom.el index 0a4b61e..34111c1 100644 --- a/atom.el +++ b/atom.el @@ -1,4 +1,4 @@ -;;; atom.el --- Create an Atom feed +;;; atom.el --- Create an Atom feed -*- lexical-binding: t -*- ;; Copyright (C) 2011 Frédéric Perrin @@ -47,17 +47,17 @@ ;; ;; (atom-print my-atom-feed) ;; ;; If you prefer RSS feeds: -;; (atom-to-rss-print my-atom-feed)) +;; (atom-print-as-rss my-atom-feed)) ;; Full documentation is available at . +;; See atom-tests.el for usage examples. ;;; Code: (require 'xml) (require 'url-parse) -(require 'cl) ; for setf in url-canonalize -(defun atom-create (title link &optional subtitle self id author updated) +(defun atom-create (title link &optional props) "Create a new atom structure. TITLE is the title for the feed, a short, text-only, human @@ -66,29 +66,34 @@ readable string. LINK is the URL of a page responible for the content of this feed. -SUBTITLE is a subtitle for the feed; it can be a bit longer than -TITLE, maybe a paragraph long. +PROPS is an optional plist with the following properties: -SELF is the canonical URL to this feed. +- :subtitle is a subtitle for the feed; it can be a bit longer than + TITLE, maybe a paragraph long. -ID is a unique identifier for this feed. If not given, it -defaults to SELF. +- :self is the canonical URL to this feed. If missing, the resulting + feed is non-conforming. -AUTHOR is the author of the feed. See `atom-massage-author' for -the possible ways to specify it. In particular, `nil' uses -`user-full-name' and `user-mail-address'. +- :id is a unique identifier for this feed. If not given, it + defaults to :self. -UPDATED is the date the feed was last updated. If not given, +- :author is the author of the feed. See `atom-massage-author' for +the possible ways to specify it. In particular, nil uses +variable `user-full-name' and `user-mail-address'. + +- :updated is the date the feed was last updated. If not given, `(current-time)' is used." (let ((atom-feed (list (list 'title nil title)))) (atom-modify-entry atom-feed 'link `(((href . ,link)))) - (atom-modify-entry atom-feed 'author (atom-massage-author author)) - (if subtitle (atom-modify-entry atom-feed 'subtitle subtitle)) - (if self (atom-modify-entry atom-feed 'link - `(((href . ,self) (rel . "self") - (type . "application/atom+xml"))))) - (atom-modify-entry atom-feed 'updated (atom-format-time updated)) - (atom-modify-entry atom-feed 'id (or id self link)) + (atom-modify-entry atom-feed 'author (atom-massage-author (plist-get props :author))) + (if (plist-member props :subtitle) + (atom-modify-entry atom-feed 'subtitle (plist-get props :subtitle))) + (if (plist-member props :self) + (atom-modify-entry atom-feed 'link + `(((href . ,(plist-get props :self)) (rel . "self") + (type . "application/atom+xml"))))) + (atom-modify-entry atom-feed 'updated (atom-format-time (plist-get props :updated))) + (atom-modify-entry atom-feed 'id (or (plist-get props :id) (plist-get props :self) link)) atom-feed)) (defun atom-push-entry (atom entry) @@ -102,10 +107,10 @@ UPDATED is the date the feed was last updated. If not given, (cons name val)))) (nconc entry (list elem)))) -(defun atom-add-entry (atom title link content - &optional updated id summary) - "Add an entry to the atom flux ATOM. Return the newly added -entry. +(defun atom-add-entry (atom title link content &optional props) + "Add an entry to the atom flux ATOM. + +Return the newly adde dentry. TITLE is a short, text-only, human readable string. @@ -115,20 +120,27 @@ may change between successive generations of the atom feed. CONTENT is the content of the entry; use `atom-add-html-entry' or `atom-add-xhtml-entry' when CONTENT is not text-only. -If SUMMARY is not given, the entry will not contain any summary. +PROPS is an optional plist with the following properties: + +- :summary, if is not given, the entry will not contain any summary. -UPDATED defaults to `(current-time)' if omitted, which is -probably not a very good default. +- :updated defaults to `(current-time)'. -ID defaults to LINK, which is not optimal; see `atom-generate-id' -for a way to create good identifiers. For a given entry, it must -not change between successive generations of the atom feed, even -when the content of the entry ." +- :published, if given, is the earliest availability of the + entry. It is optional, and shouldn't change even if the entry + content (etc.) updated after the initial publication. + +- :id is a unique ID for the entry; defaulting to LINK. RFC4287 + has specific requirements about valid IRI that may be used, + which this library does not try to enforce." (let ((entry (list (list 'title nil title)))) (atom-modify-entry entry 'link (list (list (cons 'href link)))) - (atom-modify-entry entry 'id (or id link)) - (atom-modify-entry entry 'updated (atom-format-time updated)) - (if summary (atom-modify-entry entry 'summary summary)) + (atom-modify-entry entry 'id (or (plist-get props :id) link)) + (atom-modify-entry entry 'updated (atom-format-time (plist-get props :updated))) + (if (plist-member props :published) + (atom-modify-entry entry 'published (atom-format-time (plist-get props :published)))) + (if (plist-member props :summary) + (atom-modify-entry entry 'summary (plist-get props :summary))) (atom-modify-entry entry 'content content) (atom-push-entry atom entry) entry)) @@ -137,29 +149,27 @@ when the content of the entry ." "Add an entry to ATOM, with a textual content. See `atom-add-entry' for details.") -(defun atom-add-html-entry (atom title link content - &optional updated id summary) - "Add an entry to ATOM, with some HTML content. CONTENT should -be a string enconding a valid HTML fragment. See `atom-add-entry' -for additional details." - (atom-add-entry atom - title link (atom-massage-html content) - updated id (and summary (atom-massage-html summary)))) - -(defun atom-add-xhtml-entry (atom title link content - &optional updated id summary noconvert) - "Add an entry to ATOM, with some XHTML content. CONTENT may be -given either as a string, or as an XML tree, of a valid XHTML -fragment. See `atom-add-entry' for additional details. - -If NOCONVERT is nil, translate all links in CONTENT so that they -are no longer relative to LINK." - (let ((xhtml-content (atom-massage-xhtml content))) - (unless noconvert - (atom-xhtml-convert-links (cadr xhtml-content) link)) - (atom-add-entry atom - title link xhtml-content - updated id (and summary (atom-massage-xhtml summary))))) +(defun atom-add-html-entry (atom title link content &optional props) + "Add an entry to ATOM, with some HTML content. + +TITLE, LINK, PROPS as in `atom-add-entry'. CONTENT should be a string +enconding a valid HTML fragment. See `atom-add-entry' for +additional details." + (if (plist-member props :summary) + (plist-put props :summary (atom-massage-html (plist-get props :summary)))) + (atom-add-entry atom title link (atom-massage-html content) props)) + +(defun atom-add-xhtml-entry (atom title link content &optional props) + "Add an entry to ATOM, with some XHTML content. + +TITLE, LINK, PROPS as in `atom-add-entry'. CONTENT may be given +either as a string, or as an XML tree, of a valid XHTML fragment. +See `atom-add-entry' for additional details." + (if (plist-member props :summary) + (plist-put props :summary (atom-massage-xhtml (plist-get props :summary)))) + (atom-add-entry atom title link (atom-massage-xhtml content) props)) + +(defvar atom-xml-declaration "\n") (defun atom-print (atom) "Print the Atom feed ATOM in the current buffer." @@ -175,11 +185,17 @@ are no longer relative to LINK." (write-file filename))) -(defun atom-to-rss (atom) - "Translate an Atom feed into an RSS one, returning the translation. +(defun atom-to-rss (atom &optional rss-self) + "Translate Atom feed ATOM into an RSS one, returning the translation. + +If RSS-SELF is given, it is used as self link of the RSS feed. Some information may be lost or approximated." (let ((rss (list (assoc 'title atom)))) + (if rss-self + (atom-modify-entry rss 'atom:link + `(((href . ,rss-self) (rel . "self") + (type . "application/atom+xml"))))) (atom-to-rss-translator atom rss '((subtitle . description) (updated . pubDate) (link . link))) @@ -190,7 +206,7 @@ Some information may be lost or approximated." (reverse rss))) (defun atom-to-rss-item (entry) - "Translates an Atom entry into an RSS item." + "Translates the Atom entry ENTRY into an RSS item." (let ((item (list (assoc 'title entry)))) (atom-to-rss-translator (xml-node-children entry) item @@ -203,7 +219,8 @@ Some information may be lost or approximated." (setcar (cdr guid) (list (cons 'isPermaLink "false")))) (if (and descr (equal (xml-get-attribute descr 'type) "xhtml")) - (setcar (cddr descr) (xml-node-as-text descr)))) + (setcar (cddr descr) (xml-node-as-text descr))) + (setcar (cdr descr) nil)) `(item nil ,@item))) (defun atom-to-rss-translator (source target translations) @@ -221,18 +238,23 @@ Some information may be lost or approximated." (setcar (cdr link) nil) (setcdr (cdr link) (cons link-addr nil))))) -(defun atom-print-as-rss (atom) - (let ((rss (atom-to-rss atom))) +(defun atom-print-as-rss (atom &optional rss-self) + "Convert Atom feed ATOM to RSS in the current buffer. + +If RSS-SELF is given, it is used as self link of the RSS feed." + (let ((rss (atom-to-rss atom rss-self))) (insert atom-xml-declaration) - (insert "\n") + ;; xmlns:atom included in order to allow the atom:link rel=self element + (insert "\n") (insert " \n") (xml-print rss " ") (insert "\n \n") (insert ""))) (defun atom-to-rss-time (time) - "Translates a string from the format used by Atom into the -format used by RSS." + "Translate TIME from the format used by Atom into the format used by RSS. + +TIME is a string." (let ((system-time-locale "C")) (format-time-string "%a, %d %b %Y %T %z" (atom-parse-time time)))) @@ -242,10 +264,12 @@ format used by RSS." (setcar (cddr pubDate) (atom-to-rss-time (car (xml-node-children pubDate)))))) -(defun atom-to-rss-write-file (atom filename) - "Saves ATOM as a RSS feed into FILENAME." +(defun atom-to-rss-write-file (atom filename &optional rss-self) + "Save ATOM as a RSS feed into FILENAME. + +If RSS-SELF is given, it is used as self link of the RSS feed." (with-temp-buffer - (atom-print-as-rss atom) + (atom-print-as-rss atom rss-self) (write-file filename))) @@ -254,10 +278,8 @@ format used by RSS." (defvar atom-xhtml-namespace "http://www.w3.org/1999/xhtml") -(defvar atom-xml-declaration "\n") - (defun atom-format-time (&optional time) - "Format a time according to RFC3339." + "Format time value TIME according to RFC3339." ;; The time zone must be specified in numeric form, but with a colon between ;; the hour and minute parts. (replace-regexp-in-string @@ -265,13 +287,15 @@ format used by RSS." (format-time-string atom-time-format-string time))) (defun atom-parse-time (&optional time) - "Parse a time as specified in RFC3339 into Emacs's native format." - ;; Same remark as in `atom-format-time' + "Parse string TIME as specified in RFC3339 into Emacs's native format." + ;; Same remark as in `atom-format-time': RFC3339 wants a colon between hour + ;; and minute parts of the timezome, so remove it before `date-to-time'. (date-to-time (replace-regexp-in-string ":\\(..\\)$" "\\1" time))) (defun atom-massage-html (content) - "Massage CONTENT so it can be used as an HTML fragment in an -Atom feed. CONTENT must be a string." + "Massage CONTENT so it can be used as an HTML fragment in an Atom feed. + +CONTENT must be a string." (list '((type . "html")) content)) (defun atom-string-to-xml (string) @@ -289,8 +313,7 @@ Atom feed. CONTENT must be a string." (car (xml-parse-region (point-min) (point-max)))))) (defun atom-massage-xhtml (content) - "Massage CONTENT so it can be used as an XHTML fragment in an -Atom feed." + "Massage CONTENT so it can be used as an XHTML fragment in an Atom feed." (list '((type . "xhtml")) (or (and (stringp content) (atom-string-to-xml content)) @@ -298,8 +321,8 @@ Atom feed." (defun atom-massage-author (author) "Return an XML node representing the author. AUTHOR can be: -- nil, in which case `user-full-name' and `user-mail-address' are - used; +- nil, in which case variables `user-full-name' and `user-mail-address' + are used; - a single string, the full name of the author; no email address will be included; - a list with two elements, the full name and the email address @@ -322,20 +345,11 @@ absolute, in the context of BASE, an URL." (dolist (child (xml-node-children node)) (when (listp child) (atom-xhtml-convert-links child base)))) -(defun atom-generate-id (link creation-date) - "Generate a string suitable for use as an atom:id element. This -implements Mark Pilgrom's tag: URI method, using the -CREATION-DATE of the entry, and the domain part of LINK." - (format "tag:%s,%s:/%s" - (url-host (url-generic-parse-url link)) - (format-time-string "%Y-%m-%d" creation-date) - (format-time-string "%Y%m%d%H%M%S" creation-date))) - ;;; Functions that should probably not be there (defun url-canonalize (address base) - "Make ADRESS an absolute URL, taking it in the BASE context." + "Make ADDRESS an absolute URL, taking it in the BASE context." ;; I feel such a function should exist in `url-parse'. Did I miss it? (let ((url-base (url-generic-parse-url base)) (url-address (url-generic-parse-url address))) @@ -352,9 +366,5 @@ CREATION-DATE of the entry, and the domain part of LINK." (xml-print (xml-node-children node)) (buffer-string))) -(defun xml-node-create (name attrlist childlist) - "Create a new XML node." - (list name attrlist . childlist)) - (provide 'atom) ;;; atom.el ends here