atom.el

   1 ;;; atom.el --- Create an Atom feed
   2
   3 ;; Copyright (C) 2011  Frédéric Perrin
   4
   5 ;; Author: Frédéric Perrin <frederic.perrin@resel.fr>
   6 ;; Keywords: www, hypermedia, atom, rss
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; This is a library for creating an Atom feed from a Lisp program.
  24 ;; The normal usage is to create a feed with `atom-create', giving it
  25 ;; a title and a Web address. Once the feed has been created, entries
  26 ;; may be added to the feed, by specifying (at the minimum) a title, a
  27 ;; permanent link and the content of the entry. Text-only, HTML and
  28 ;; XHTML entries are supported.
  29
  30 ;; A feed is really a Lisp structure as used by the `xml.el' package,
  31 ;; without the parent `feed' element.
  32
  33 ;; A typical usage would look like this:
  34
  35 ;; (let ((my-atom-feed (atom-create "My feed" "http://example.org")))
  36 ;;   ; A simple, text-only entry
  37 ;;   (atom-add-text-entry
  38 ;;    my-atom-feed
  39 ;;    "Hello world"
  40 ;;    "http://example.org/hello"
  41 ;;    "Hello the world!")
  42 ;;
  43 ;;   ; A text-only entry, with all the optional pieces of data
  44 ;;   (atom-add-text-entry
  45 ;;    my-atom-feed
  46 ;;    "Bonjour"
  47 ;;    "http://example.org/bonjour"
  48 ;;    "Bonjour à tout le monde !"
  49 ;;    ;; optional: the last modification time
  50 ;;    (date-to-time "2011-01-30 23:40:12")
  51 ;;    ;; optional: an identifier for this entry; a common way to generate it is
  52 ;;    ;; to use the domain name and the creation date of the entry.
  53 ;;    (atom-generate-id "http://example.org"
  54 ;;                   (date-to-time "2011-01-30 10:01:05"))
  55 ;;    ;; optional: a summary for this entry
  56 ;;    "Bonjour, monde.")
  57 ;;
  58 ;;   (atom-add-xhtml-entry
  59 ;;    my-atom-feed
  60 ;;    "An XHTML example"
  61 ;;    "http://example.org/html-example"
  62 ;;    "<p>One can also use <acronym>XHTML</acronym> in the entries.</p>")
  63 ;;   (atom-print my-atom-feed))
  64
  65 ;;; Code:
  66
  67 (require 'xml)
  68
  69 (defun atom-create (title link &optional author self updated id)
  70   "Create a new atom structure.
  71
  72 TITLE is the title for the feed, a short, text-only, human
  73 readable string.
  74
  75 AUTHOR is the author of the feed. See `atom-massage-author' for
  76 the possible ways to specify it.
  77
  78 SELF is the canonical URL to this feed.
  79
  80 LINK is the URL of a page responible for the content of this
  81 feed.
  82
  83 UPDATED is the date the feed was last updated. If not given,
  84 `(current-time)' is used.
  85
  86 ID is a unique identifier for this feed. If not given, it
  87 defaults to LINK."
  88   (let ((atom-feed (list (list 'title nil title))))
  89     (atom-modify-entry atom-feed 'link `(((href . ,link))))
  90     (atom-modify-entry atom-feed 'author (atom-massage-author author))
  91     (if self (atom-modify-entry atom-feed 'link
  92                                 `(((href . ,self) (rel . "self")
  93                                    (type . "application/atom+xml")))))
  94     (atom-modify-entry atom-feed 'updated (atom-format-time updated))
  95     (atom-modify-entry atom-feed 'id (or id link))
  96     atom-feed))
  97
  98 (defun atom-push-entry (atom entry)
  99   "Add the entry ENTRY to the feed ATOM."
 100   (nconc atom (list `(entry nil ,@entry))))
 101
 102 (defun atom-modify-entry (entry name val)
 103   "Set the NAME element of ENTRY to VAL. A true MULTIPLE means
 104 to add a new element instead of updating it when it already exists."
 105   (let ((elem (if (stringp val)
 106                   (list name nil val)
 107                 (cons name val))))
 108     (nconc entry (list elem))))
 109
 110 (defun atom-add-entry (atom title link content
 111                             &optional updated id summary)
 112   "Add an entry to the atom flux ATOM. Return the newly added
 113 entry.
 114
 115 TITLE is a short, text-only, human readable string.
 116
 117 LINK is a permanent link for this entry. For a given entry, LINK
 118 may change between successive generations of the atom feed.
 119
 120 CONTENT is the content of the entry; use `atom-add-html-entry'
 121 or `atom-add-xhtml-entry' when CONTENT is not text-only.
 122
 123 If SUMMARY is not given, the entry will not contain any summary.
 124
 125 UPDATED defaults to `(current-time)' if omitted, which is
 126 probably not a very good default.
 127
 128 ID defaults to LINK, which is not optimal; see `atom-generate-id'
 129 for a way to create good identifiers. For a given entry, it must
 130 not change between successive generations of the atom feed, even
 131 when the content of the entry ."
 132   (let ((entry (list (list 'title nil title))))
 133     (atom-modify-entry entry 'link  (list (list (cons 'href link))))
 134     (atom-modify-entry entry 'id (or id link))
 135     (atom-modify-entry entry 'updated (atom-format-time updated))
 136     (if summary (atom-modify-entry entry 'summary summary))
 137     (atom-modify-entry entry 'content content)
 138     (atom-push-entry atom entry)
 139     entry))
 140
 141 (defalias 'atom-add-text-entry 'atom-add-entry
 142   "Add an entry to ATOM, with a textual content. See
 143 `atom-add-entry' for details.")
 144
 145 (defun atom-add-html-entry (atom title link content
 146                                   &optional updated id summary)
 147   "Add an entry to ATOM, with some HTML content. CONTENT should
 148 be a string enconding a valid HTML fragment. See `atom-add-entry'
 149 for additional details."
 150   (atom-add-entry atom
 151    title link
 152    (atom-massage-html content)
 153    (and summary (atom-massage-html summary))
 154    updated id))
 155
 156 (defun atom-add-xhtml-entry (atom title link content
 157                                   &optional updated id summary)
 158   "Add an entry to ATOM, with some XHTML content. CONTENT may be
 159 given either as a string, or as an XML tree, of a valid XHTML
 160 fragment. See `atom-add-entry' for additional details."
 161   (atom-add-entry atom
 162    title link
 163    (atom-massage-xhtml content)
 164    (and summary (atom-massage-xhtml summary))
 165    updated id))
 166
 167 (defun atom-print (atom)
 168   "Print the Atom feed ATOM in the current buffer."
 169   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
 170   (insert "<feed xmlns=\"http://www.w3.org/2005/Atom\">\n")
 171   (xml-print atom)
 172   (insert "\n</feed>"))
 173
 174 \f
 175 (defun atom-format-time (&optional time)
 176   "Format a time according to RFC3339."
 177   ;; The time zone must be specified in numeric form, but with a colon between
 178   ;; the hour and minute parts.
 179   (replace-regexp-in-string
 180    "\\(..\\)$"
 181    ":\\1"
 182    (format-time-string "%Y-%m-%dT%T%z" time)))
 183
 184 (defun atom-massage-html (content)
 185   "Massage CONTENT so it can be used as an HTML fragment in an
 186 Atom feed. CONTENT must be a string."
 187   (list '((type . "html")) content))
 188
 189 (defun atom-string-to-xml (string)
 190   "Convert STRING into a Lisp structure as used by `xml.el'."
 191   (with-temp-buffer
 192     (insert string)
 193     (xml-parse-region (point-min) (point-max))))
 194
 195 (defun atom-massage-xhtml (content)
 196   "Massage CONTENT so it can be used as an XHTML fragment in an
 197 Atom feed."
 198   (list '((type . "xhtml"))
 199         `(div ((xmlns . "http://www.w3.org/1999/xhtml"))
 200               ,@(or (and (stringp content)
 201                          (atom-string-to-xml content))
 202                     content))))
 203
 204 (defun atom-massage-author (author)
 205   "Return an XML node representing the author. AUTHOR can be:
 206 - nil, in which case `user-full-name' and `user-mail-address' are
 207   used;
 208 - a single string, the full name of the author;
 209 - a list with two elements, the full name and the email address
 210   of the author;
 211 - something else, assumed to be a complete `atomPersonConstruct'."
 212   `(nil ,@(cond
 213            ((null author) `((name nil ,user-full-name)
 214                             (email nil ,user-mail-address)))
 215            ((stringp author) `((name nil ,author)))
 216            ((= 2 (length author)) `((name nil ,(car author))
 217                                     (email nil ,(cadr author))))
 218            (t `(author nil ,author)))))
 219
 220 (require 'url-parse)
 221
 222 (defun atom-generate-id (link creation-date)
 223   "Generate a string suitable for use as an atom:id element. This
 224 implements Mark Pilgrom's tag: URI method, using the
 225 CREATION-DATE of the entry, and the domain part of LINK."
 226     (format "tag:%s,%s:/%s"
 227             (url-host (url-generic-parse-url link))
 228             (format-time-string "%Y-%m-%d" creation-date)
 229             (format-time-string "%Y%m%d%H%M%S" creation-date)))
 230
 231 (provide 'atom)
 232 ;;; atom.el ends here