X-Git-Url: http://gitweb.fperrin.net/?p=atom.el.git;a=blobdiff_plain;f=atom.el;h=c4224b85680ae273b942936da6236319ce99bd89;hp=5d3df7b1544872027698f9f6a631905d2a318db0;hb=ed7d99f83fafe4f60eac3d5416212e6c9af010af;hpb=d32925eb5a6b87479832943c6e27cb65c64f50fe
diff --git a/atom.el b/atom.el
index 5d3df7b..c4224b8 100644
--- a/atom.el
+++ b/atom.el
@@ -27,8 +27,7 @@
;; permanent link and the content of the entry. Text-only, HTML and
;; XHTML entries are supported.
-;; A feed is really a Lisp structure as used by the `xml.el' package,
-;; without the parent `feed' element.
+;; It is possible to produce both Atom and RSS feeds.
;; A typical usage would look like this:
@@ -40,27 +39,17 @@
;; "http://example.org/hello"
;; "Hello the world!")
;;
-;; ; A text-only entry, with all the optional pieces of data
-;; (atom-add-text-entry
-;; my-atom-feed
-;; "Bonjour"
-;; "http://example.org/bonjour"
-;; "Bonjour à tout le monde !"
-;; ;; optional: the last modification time
-;; (date-to-time "2011-01-30 23:40:12")
-;; ;; optional: an identifier for this entry; a common way to generate it is
-;; ;; to use the domain name and the creation date of the entry.
-;; (atom-generate-id "http://example.org"
-;; (date-to-time "2011-01-30 10:01:05"))
-;; ;; optional: a summary for this entry
-;; "Bonjour, monde.")
-;;
;; (atom-add-xhtml-entry
;; my-atom-feed
;; "An XHTML example"
;; "http://example.org/html-example"
;; "One can also use XHTML in the entries.
")
-;; (atom-print my-atom-feed))
+;;
+;; (atom-print my-atom-feed)
+;; ;; If you prefer RSS feeds:
+;; (atom-to-rss-print my-atom-feed))
+
+;; Full documentation is available at .
;;; Code:
@@ -134,7 +123,7 @@ probably not a very good default.
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 ."
+when the content of the entry changes."
(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))
@@ -163,8 +152,8 @@ for additional details."
given either as a string, or as an XML tree, of a valid XHTML
fragment. See `atom-add-entry' for additional details.
-If CONVERT, translate all links in CONTENT so that they are no
-longer relative to LINK."
+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))
@@ -174,7 +163,7 @@ longer relative to LINK."
(defun atom-print (atom)
"Print the Atom feed ATOM in the current buffer."
- (insert "\n")
+ (insert atom-xml-declaration)
(insert "\n")
(xml-print atom)
(insert "\n"))
@@ -183,7 +172,7 @@ longer relative to LINK."
"Writes the feed ATOM to FILENAME."
(with-temp-buffer
(atom-print atom)
- (write-region (point-min) (point-max) filename)))
+ (write-file filename)))
(defun atom-to-rss (atom)
@@ -214,7 +203,7 @@ 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-text descr))))
+ (setcar (cddr descr) (xml-node-as-text descr))))
`(item nil ,@item)))
(defun atom-to-rss-translator (source target translations)
@@ -225,11 +214,6 @@ Some information may be lost or approximated."
(when data
(atom-modify-entry target to data)))))
-(defun xml-node-text (node)
- (with-temp-buffer
- (xml-print (xml-node-children node))
- (buffer-string)))
-
(defun atom-to-rss-modify-link (entry)
(let* ((link (assoc 'link entry))
(link-addr (xml-get-attribute-or-nil link 'href)))
@@ -239,7 +223,7 @@ Some information may be lost or approximated."
(defun atom-print-as-rss (atom)
(let ((rss (atom-to-rss atom)))
- (insert "\n")
+ (insert atom-xml-declaration)
(insert "\n")
(insert " \n")
(xml-print rss " ")
@@ -249,7 +233,6 @@ Some information may be lost or approximated."
(defun atom-to-rss-time (time)
"Translates a string from the format used by Atom into the
format used by RSS."
- ;; Same remark as in `atom-format-time'
(let ((system-time-locale "C"))
(format-time-string "%a, %d %b %Y %T %z" (atom-parse-time time))))
@@ -263,12 +246,16 @@ format used by RSS."
"Saves ATOM as a RSS feed into FILENAME."
(with-temp-buffer
(atom-print-as-rss atom)
- (write-region nil nil filename)))
+ (write-file filename)))
(defvar atom-time-format-string "%Y-%m-%dT%T%z"
"The format for string representation of dates.")
+(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."
;; The time zone must be specified in numeric form, but with a colon between
@@ -279,6 +266,7 @@ format used by RSS."
(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'
(date-to-time (replace-regexp-in-string ":\\(..\\)$" "\\1" time)))
(defun atom-massage-html (content)
@@ -288,25 +276,32 @@ Atom feed. CONTENT must be a string."
(defun atom-string-to-xml (string)
"Convert STRING into a Lisp structure as used by `xml.el'."
- (with-temp-buffer
- (insert "")
- (insert string)
- (insert "
")
- (xml-parse-region (point-min) (point-max))))
+ (require 'xml-xhtml-entities)
+ (let ((xml-entity-alist xml-xhtml-entities)
+ (xml-validating-parser t))
+ (with-temp-buffer
+ (insert "")
+ (insert string)
+ (insert "
")
+ ;; `xml-parse-region' returns a list of elements, even though it
+ ;; requires an only root node. We are only interested in the first
+ ;; one, the DIV we just inserted.
+ (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."
- `(((type . "xhtml"))
- ,@(or (and (stringp content)
- (atom-string-to-xml content))
- content)))
+ (list '((type . "xhtml"))
+ (or (and (stringp content)
+ (atom-string-to-xml content))
+ `(div ((xmlns . ,atom-xhtml-namespace)) ,@content))))
(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;
-- a single string, the full name of the author;
+- 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
of the author;
- something else, assumed to be a complete `atomPersonConstruct'."
@@ -327,6 +322,18 @@ 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."
;; I feel such a function should exist in `url-parse'. Did I miss it?
@@ -339,14 +346,15 @@ absolute, in the context of BASE, an URL."
(file-name-directory (url-filename url-base))))
(url-recreate-url url-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)))
+(defun xml-node-as-text (node)
+ "Return a string representing NODE, an XML structure."
+ (with-temp-buffer
+ (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