Remove dead code

[atom.git] / atom.el

diff --git a/atom.el b/atom.el
index 51c9d7d0ba20b1d61a87d11b75ae9967756cf77c..d0d2590bd23599556efa99cf5ca052fc46252c32 100644 (file)
--- 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
 
 
 ;; Copyright (C) 2011  Frédéric Perrin
 


@@ -47,17 +47,17 @@
 ;;
 ;;   (atom-print my-atom-feed)
 ;;   ;; If you prefer RSS feeds:
 ;;
 ;;   (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 <http://tar-jx.bz/code/atom.html>.
 
 ;; Full documentation is available at <http://tar-jx.bz/code/atom.html>.

+;; See 

 
 ;;; Code:
 
 (require 'xml)
 (require 'url-parse)
 
 ;;; 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
   "Create a new atom structure.
 
 TITLE is the title for the feed, a short, text-only, human


@@ -66,29 +66,33 @@ readable string.
 LINK is the URL of a page responible for the content of this
 feed.
 
 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.

 
 

-AUTHOR is the author of the feed. See `atom-massage-author' for
+- :id is a unique identifier for this feed. If not given, it
+  defaults to :self.
+
+- :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'.
 
 the possible ways to specify it. In particular, `nil' uses
 `user-full-name' and `user-mail-address'.
 

-UPDATED is the date the feed was last updated. If not given,
+- :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))))
 `(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)
     atom-feed))
 
 (defun atom-push-entry (atom entry)


@@ -102,8 +106,7 @@ UPDATED is the date the feed was last updated. If not given,
                (cons name val))))
     (nconc entry (list elem))))
 
                (cons name val))))
     (nconc entry (list elem))))
 

-(defun atom-add-entry (atom title link content
-                           &optional updated id summary)
+(defun atom-add-entry (atom title link content &optional props)

   "Add an entry to the atom flux ATOM. Return the newly added
 entry.
 
   "Add an entry to the atom flux ATOM. Return the newly added
 entry.
 


@@ -123,12 +126,13 @@ 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
 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))))
   (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 :summary)
+       (atom-modify-entry entry 'summary (plist-get props :summary)))

     (atom-modify-entry entry 'content content)
     (atom-push-entry atom entry)
     entry))
     (atom-modify-entry entry 'content content)
     (atom-push-entry atom entry)
     entry))


@@ -137,33 +141,25 @@ when the content of the entry ."
   "Add an entry to ATOM, with a textual content. See
 `atom-add-entry' for details.")
 
   "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)
+(defun atom-add-html-entry (atom title link content &optional props)

   "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."
   "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))))
+  (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 updated id summary noconvert)
+(defun atom-add-xhtml-entry (atom title link content &optional props)

   "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
   "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 CONVERT, 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)))))
+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))

 
 (defun atom-print (atom)
   "Print the Atom feed ATOM in the current buffer."
 
 (defun atom-print (atom)
   "Print the Atom feed ATOM in the current buffer."

-  (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
+  (insert atom-xml-declaration)

   (insert "<feed xmlns=\"http://www.w3.org/2005/Atom\">\n")
   (xml-print atom)
   (insert "\n</feed>"))
   (insert "<feed xmlns=\"http://www.w3.org/2005/Atom\">\n")
   (xml-print atom)
   (insert "\n</feed>"))


@@ -172,14 +168,18 @@ longer relative to LINK."
   "Writes the feed ATOM to FILENAME."
   (with-temp-buffer
     (atom-print atom)
   "Writes the feed ATOM to FILENAME."
   (with-temp-buffer
     (atom-print atom)

-    (write-region (point-min) (point-max) filename)))
+    (write-file filename)))

 
 \f
 
 \f

-(defun atom-to-rss (atom)
+(defun atom-to-rss (atom &optional rss-self)

   "Translate an Atom feed into an RSS one, returning the translation.
 
 Some information may be lost or approximated."
   (let ((rss (list (assoc 'title atom))))
   "Translate an Atom feed into an RSS one, returning the translation.
 
 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)))
     (atom-to-rss-translator atom rss '((subtitle . description)
                                       (updated . pubDate)
                                       (link . link)))


@@ -203,7 +203,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 (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)
     `(item nil ,@item)))
 
 (defun atom-to-rss-translator (source target translations)


@@ -221,10 +222,11 @@ Some information may be lost or approximated."
       (setcar (cdr link) nil)
       (setcdr (cdr link) (cons link-addr nil)))))
 
       (setcar (cdr link) nil)
       (setcdr (cdr link) (cons link-addr nil)))))
 

-(defun atom-print-as-rss (atom)
-  (let ((rss (atom-to-rss atom)))
-    (insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n")
-    (insert "<rss version=\"2.0\">\n")
+(defun atom-print-as-rss (atom &optional rss-self)
+  (let ((rss (atom-to-rss atom rss-self)))
+    (insert atom-xml-declaration)
+    ;; xmlns:atom included in order to allow the atom:link rel=self element
+    (insert "<rss version=\"2.0\" xmlns:atom=\"http://www.w3.org/2005/Atom\">\n")

     (insert "  <channel>\n")
     (xml-print rss "    ")
     (insert "\n  </channel>\n")
     (insert "  <channel>\n")
     (xml-print rss "    ")
     (insert "\n  </channel>\n")


@@ -233,7 +235,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."
 (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))))
 
   (let ((system-time-locale "C"))
     (format-time-string "%a, %d %b %Y %T %z" (atom-parse-time time))))
 


@@ -243,16 +244,20 @@ format used by RSS."
     (setcar (cddr pubDate)
            (atom-to-rss-time (car (xml-node-children pubDate))))))
 
     (setcar (cddr pubDate)
            (atom-to-rss-time (car (xml-node-children pubDate))))))
 

-(defun atom-to-rss-write-file (atom filename)
+(defun atom-to-rss-write-file (atom filename &optional rss-self)

   "Saves ATOM as a RSS feed into FILENAME."
   (with-temp-buffer
   "Saves ATOM as a RSS feed into FILENAME."
   (with-temp-buffer

-    (atom-print-as-rss atom)
-    (write-region nil nil filename)))
+    (atom-print-as-rss atom rss-self)
+    (write-file filename)))

 
 \f
 (defvar atom-time-format-string "%Y-%m-%dT%T%z"
   "The format for string representation of dates.")
 
 
 \f
 (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 "<?xml version=\"1.0\" encoding=\"utf-8\"?>\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
 (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


@@ -263,6 +268,7 @@ format used by RSS."
 
 (defun atom-parse-time (&optional time)
   "Parse a time as specified in RFC3339 into Emacs's native format."
 
 (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)
   (date-to-time (replace-regexp-in-string ":\\(..\\)$" "\\1" time)))
 
 (defun atom-massage-html (content)


@@ -272,14 +278,17 @@ Atom feed. CONTENT must be a string."
 
 (defun atom-string-to-xml (string)
   "Convert STRING into a Lisp structure as used by `xml.el'."
 
 (defun atom-string-to-xml (string)
   "Convert STRING into a Lisp structure as used by `xml.el'."

-  (with-temp-buffer
-    (insert "<div xmlns=\"http://www.w3.org/1999/xhtml\">")
-    (insert string)
-    (insert "</div>")
-    ;; `xml-parse-region' doesn't require that the XML parsed be enclosed in a
-    ;; root node, and accordingly, returns a list of elements. We are only
-    ;; interested in the first one, the DIV we just inserted.
-    (car (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 "<div xmlns=\"" atom-xhtml-namespace "\">")
+      (insert string)
+      (insert "</div>")
+      ;; `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
 
 (defun atom-massage-xhtml (content)
   "Massage CONTENT so it can be used as an XHTML fragment in an


@@ -287,7 +296,7 @@ Atom feed."
   (list '((type . "xhtml"))
        (or (and (stringp content)
                 (atom-string-to-xml content))
   (list '((type . "xhtml"))
        (or (and (stringp content)
                 (atom-string-to-xml content))

-           `(div ((xmlns . "http://www.w3.org/1999/xhtml\">")) ,@content))))
+           `(div ((xmlns . ,atom-xhtml-namespace)) ,@content))))

 
 (defun atom-massage-author (author)
   "Return an XML node representing the author. AUTHOR can be:
 
 (defun atom-massage-author (author)
   "Return an XML node representing the author. AUTHOR can be:


@@ -315,15 +324,6 @@ absolute, in the context of BASE, an URL."
   (dolist (child (xml-node-children node))
     (when (listp child) (atom-xhtml-convert-links child base))))
 
   (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)))
-

 \f
 ;;; Functions that should probably not be there
 
 \f
 ;;; Functions that should probably not be there