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 file from a Lisp program.
  24
  25 ;; A typical usage would look like this:
  26
  27 ;; (let ((my-atom-feed (atom-create "My feed" "http://example.org")))
  28 ;;   (atom-add-text-entry my-atom-feed
  29 ;;                     "Hello world"
  30 ;;                     "http://example.org/hello"
  31 ;;                     "Hello the world!")
  32 ;;   (atom-add-xhtml-entry my-atom-feed
  33 ;;                      "An XHTML example"
  34 ;;                      "http://example.org/html-example"
  35 ;;                      "<p>One can also use <acronym>XHTML</acronym> in the
  36 ;;                          entries.</p>")
  37 ;;   (atom-print my-atom-feed))
  38
  39 ;;; Code:
  40
  41 (defun atom-create (title link &optional author updated id)
  42   "Create a new atom structure.
  43
  44 TITLE is the title for the feed, a short, text-only, human
  45 readable string.
  46
  47 AUTHOR is the author of the feed. See `atom-massage-author' for
  48 the possible ways to specify it.
  49
  50 LINK is the URL of a page responible for the content of this
  51 feed.
  52
  53 UPDATED is the date the feed was last updated. If not given,
  54 `(current-time)' is used.
  55
  56 ID is a unique identifier for this feed. If not given, it
  57 defaults to LINK."
  58
  59   `((title nil ,title)
  60     (link ((href . ,link)))
  61     ,(atom-massage-author author)
  62     (updated nil ,(atom-format-time updated))
  63     (id nil ,(or id link))))
  64
  65 (defun atom-push-entry (atom entry)
  66   "Add the entry ENTRY to the feed ATOM."
  67   (nconc atom (list `(entry nil . ,entry))))
  68
  69 (defun atom-modify-entry (entry name val)
  70   "Set the NAME element of ENTRY to VAL."
  71   (let ((elem (assoc name entry)))
  72     (if elem
  73         (if (stringp val)
  74             (setcar (cddr elem) val)
  75           (setcdr elem val))
  76       (setq elem (if (stringp val)
  77                      (list name nil val)
  78                    (cons name val)))
  79       (nconc entry (list elem)))))
  80
  81 (defun atom-add-entry (atom title link content
  82                             &optional summary updated id)
  83   "Add an entry to the atom flux ATOM. Return the newly added
  84 entry.
  85
  86 TITLE is a short, text-only, human readable string.
  87
  88 LINK is a permanent link for this entry. For a given entry, LINK
  89 may change between successive generations of the atom feed.
  90
  91 CONTENT is the content of the entry; use `atom-add-html-entry'
  92 or `atom-add-xhtml-entry' when CONTENT is not text-only.
  93
  94 If SUMMARY is not given, the entry will not contain any summary.
  95
  96 UPDATED defaults to `(current-time)' if omitted, which is
  97 probably not a very good default.
  98
  99 ID defaults to LINK, which is not optimal; TODO give a way to
 100 easily generate IDs. For a given entry, it must not change
 101 between successive generations of the atom feed."
 102   (let ((entry (list (list 'title nil title))))
 103     (atom-modify-entry entry 'link  (list (list (cons 'href link))))
 104     (atom-modify-entry entry 'id (or id link))
 105     (atom-modify-entry entry 'updated (atom-format-time updated))
 106     (if summary (atom-modify-entry entry 'summary summary))
 107     (atom-modify-entry entry 'content content)
 108     (atom-push-entry atom entry)
 109     entry))
 110
 111 (defalias 'atom-add-text-entry 'atom-add-entry
 112   "Add an entry to ATOM, with a textual content. See
 113 `atom-add-entry' for details.")
 114
 115 (defun atom-add-html-entry (atom title link content
 116                                   &optional summary updated id)
 117   "Add an entry to ATOM, with some HTML content. CONTENT should
 118 be a string enconding a valid HTML fragment. See `atom-add-entry'
 119 for additional details."
 120   (atom-add-entry atom
 121    title link
 122    (atom-massage-html content)
 123    (and summary (atom-massage-html summary))
 124    updated id))
 125
 126 (defun atom-add-xhtml-entry (atom title link content
 127                                   &optional summary updated id)
 128   "Add an entry to ATOM, with some XHTML content. CONTENT may be
 129 given either as a string, or as an XML tree, of a valid XHTML
 130 fragment. See `atom-add-entry' for additional details."
 131   (atom-add-entry atom
 132    title link
 133    (atom-massage-xhtml content)
 134    (and summary (atom-massage-xhtml summary))
 135    updated id))
 136
 137 (defun atom-print (atom)
 138   "Print the Atom feed ATOM in the current buffer."
 139   (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
 140   (insert "<feed xmlns=\"http://www.w3.org/2005/Atom\">\n")
 141   (xml-print atom)
 142   (insert "\n</feed>"))
 143
 144 \f
 145 (defun atom-format-time (&optional time)
 146   "Format a time according to RFC3339."
 147   ;; The time zone must be specified in numeric form, but with a colon between
 148   ;; the hour and minute parts.
 149   (replace-regexp-in-string
 150    "\\(..\\)$"
 151    ":\\1"
 152    (format-time-string "%Y-%m-%dT%T%z" time)))
 153
 154 (defun atom-massage-html (content)
 155   "Massage CONTENT so it can be used as an HTML fragment in an
 156 Atom feed. CONTENT must be a string."
 157   (list '((type . "html")) content))
 158
 159 (defun atom-string-to-xml (string)
 160   "Convert STRING into a Lisp structure as used by `xml.el'."
 161   (with-temp-buffer
 162     (insert string)
 163     (xml-parse-region (point-min) (point-max))))
 164
 165 (defun atom-massage-xhtml (content)
 166   "Massage CONTENT so it can be used as an XHTML fragment in an
 167 Atom feed."
 168   (list '((type . "xhtml"))
 169         `(div ((xmlns . "http://www.w3.org/1999/xhtml"))
 170               . ,(or (and (stringp content)
 171                           (atom-string-to-xml content))
 172                      content))))
 173
 174 (defun atom-massage-author (author)
 175   "Return an XML node representing the author. AUTHOR can be:
 176 - nil, in which case `user-full-name' and `user-mail-address' are
 177   used;
 178 - a single string, the full name of the author;
 179 - a list with two elements, the full name and the email address
 180   of the author;
 181 - something else, assumed to be a complete `atomPersonConstruct'."
 182   (cond
 183    ((null author) `(author nil
 184                            (name nil ,user-full-name)
 185                            (email nil ,user-mail-address)))
 186    ((stringp author) `(author nil
 187                               (name nil ,user-full-name)))
 188    ((= 2 (length author)) `(author nil (name nil ,(car author))
 189                                    (email nil ,(cadr author))))
 190    (t `(author nil ,author))))
 191
 192 (provide 'atom)
 193 ;;; atom.el ends here