system-manager-wakasu
  1;;; ox-rss.el --- RSS 2.0 Back-End for Org Export Engine
  2
  3;; Copyright (C) 2013-2015  Bastien Guerry
  4
  5;; Author: Bastien Guerry <bzg@gnu.org>
  6;; Keywords: org, wp, blog, feed, rss
  7
  8;; This file is not yet part of GNU Emacs.
  9
 10;; This program is free software: you can redistribute it and/or modify
 11;; it under the terms of the GNU General Public License as published by
 12;; the Free Software Foundation, either version 3 of the License, or
 13;; (at your option) any later version.
 14
 15;; This program is distributed in the hope that it will be useful,
 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 18;; GNU General Public License for more details.
 19
 20;; You should have received a copy of the GNU General Public License
 21;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 22
 23;;; Commentary:
 24
 25;; This library implements a RSS 2.0 back-end for Org exporter, based on
 26;; the `html' back-end.
 27;;
 28;; It requires Emacs 24.1 at least.
 29;;
 30;; It provides two commands for export, depending on the desired output:
 31;; `org-rss-export-as-rss' (temporary buffer) and `org-rss-export-to-rss'
 32;; (as a ".xml" file).
 33;;
 34;; This backend understands two new option keywords:
 35;;
 36;; #+RSS_EXTENSION: xml
 37;; #+RSS_IMAGE_URL: http://myblog.org/mypicture.jpg
 38;;
 39;; It uses #+HTML_LINK_HOME: to set the base url of the feed.
 40;;
 41;; Exporting an Org file to RSS modifies each top-level entry by adding a
 42;; PUBDATE property.  If `org-rss-use-entry-url-as-guid', it will also add
 43;; an ID property, later used as the guid for the feed's item.
 44;;
 45;; The top-level headline is used as the title of each RSS item unless
 46;; an RSS_TITLE property is set on the headline.
 47;;
 48;; You typically want to use it within a publishing project like this:
 49;;
 50;; (add-to-list
 51;;  'org-publish-project-alist
 52;;  '("homepage_rss"
 53;;    :base-directory "~/myhomepage/"
 54;;    :base-extension "org"
 55;;    :rss-image-url "http://lumiere.ens.fr/~guerry/images/faces/15.png"
 56;;    :html-link-home "http://lumiere.ens.fr/~guerry/"
 57;;    :html-link-use-abs-url t
 58;;    :rss-extension "xml"
 59;;    :publishing-directory "/home/guerry/public_html/"
 60;;    :publishing-function (org-rss-publish-to-rss)
 61;;    :section-numbers nil
 62;;    :exclude ".*"            ;; To exclude all files...
 63;;    :include ("index.org")   ;; ... except index.org.
 64;;    :table-of-contents nil))
 65;;
 66;; ... then rsync /home/guerry/public_html/ with your server.
 67;;
 68;; By default, the permalink for a blog entry points to the headline.
 69;; You can specify a different one by using the :RSS_PERMALINK:
 70;; property within an entry.
 71
 72;;; Code:
 73
 74(require 'ox-html)
 75(declare-function url-encode-url "url-util" (url))
 76
 77;;; Variables and options
 78
 79(defgroup org-export-rss nil
 80  "Options specific to RSS export back-end."
 81  :tag "Org RSS"
 82  :group 'org-export
 83  :version "24.4"
 84  :package-version '(Org . "8.0"))
 85
 86(defcustom org-rss-image-url "http://orgmode.org/img/org-mode-unicorn-logo.png"
 87  "The URL of the an image for the RSS feed."
 88  :group 'org-export-rss
 89  :type 'string)
 90
 91(defcustom org-rss-extension "xml"
 92  "File extension for the RSS 2.0 feed."
 93  :group 'org-export-rss
 94  :type 'string)
 95
 96(defcustom org-rss-categories 'from-tags
 97  "Where to extract items category information from.
 98The default is to extract categories from the tags of the
 99headlines.  When set to another value, extract the category
100from the :CATEGORY: property of the entry."
101  :group 'org-export-rss
102  :type '(choice
103	  (const :tag "From tags" from-tags)
104	  (const :tag "From the category property" from-category)))
105
106(defcustom org-rss-use-entry-url-as-guid t
107  "Use the URL for the <guid> metatag?
108When nil, Org will create ids using `org-icalendar-create-uid'."
109  :group 'org-export-rss
110  :type 'boolean)
111
112;;; Define backend
113
114(org-export-define-derived-backend 'rss 'html
115  :menu-entry
116  '(?r "Export to RSS"
117       ((?R "As RSS buffer"
118	    (lambda (a s v b) (org-rss-export-as-rss a s v)))
119	(?r "As RSS file" (lambda (a s v b) (org-rss-export-to-rss a s v)))
120	(?o "As RSS file and open"
121	    (lambda (a s v b)
122	      (if a (org-rss-export-to-rss t s v)
123		(org-open-file (org-rss-export-to-rss nil s v)))))))
124  :options-alist
125  '((:description "DESCRIPTION" nil nil newline)
126    (:keywords "KEYWORDS" nil nil space)
127    (:with-toc nil nil nil) ;; Never include HTML's toc
128    (:rss-extension "RSS_EXTENSION" nil org-rss-extension)
129    (:rss-image-url "RSS_IMAGE_URL" nil org-rss-image-url)
130    (:rss-categories nil nil org-rss-categories))
131  :filters-alist '((:filter-final-output . org-rss-final-function))
132  :translate-alist '((headline . org-rss-headline)
133		     (comment . (lambda (&rest args) ""))
134		     (comment-block . (lambda (&rest args) ""))
135		     (timestamp . (lambda (&rest args) ""))
136		     (plain-text . org-rss-plain-text)
137		     (section . org-rss-section)
138		     (template . org-rss-template)))
139
140;;; Export functions
141
142;;;###autoload
143(defun org-rss-export-as-rss (&optional async subtreep visible-only)
144  "Export current buffer to a RSS buffer.
145
146If narrowing is active in the current buffer, only export its
147narrowed part.
148
149If a region is active, export that region.
150
151A non-nil optional argument ASYNC means the process should happen
152asynchronously.  The resulting buffer should be accessible
153through the `org-export-stack' interface.
154
155When optional argument SUBTREEP is non-nil, export the sub-tree
156at point, extracting information from the headline properties
157first.
158
159When optional argument VISIBLE-ONLY is non-nil, don't export
160contents of hidden elements.
161
162Export is done in a buffer named \"*Org RSS Export*\", which will
163be displayed when `org-export-show-temporary-export-buffer' is
164non-nil."
165  (interactive)
166  (let ((file (buffer-file-name (buffer-base-buffer))))
167    (org-icalendar-create-uid file 'warn-user)
168    (org-rss-add-pubdate-property))
169  (org-export-to-buffer 'rss "*Org RSS Export*"
170    async subtreep visible-only nil nil (lambda () (text-mode))))
171
172;;;###autoload
173(defun org-rss-export-to-rss (&optional async subtreep visible-only)
174  "Export current buffer to a RSS file.
175
176If narrowing is active in the current buffer, only export its
177narrowed part.
178
179If a region is active, export that region.
180
181A non-nil optional argument ASYNC means the process should happen
182asynchronously.  The resulting file should be accessible through
183the `org-export-stack' interface.
184
185When optional argument SUBTREEP is non-nil, export the sub-tree
186at point, extracting information from the headline properties
187first.
188
189When optional argument VISIBLE-ONLY is non-nil, don't export
190contents of hidden elements.
191
192Return output file's name."
193  (interactive)
194  (let ((file (buffer-file-name (buffer-base-buffer))))
195    (org-icalendar-create-uid file 'warn-user)
196    (org-rss-add-pubdate-property))
197  (let ((outfile (org-export-output-file-name
198		  (concat "." org-rss-extension) subtreep)))
199    (org-export-to-file 'rss outfile async subtreep visible-only)))
200
201;;;###autoload
202(defun org-rss-publish-to-rss (plist filename pub-dir)
203  "Publish an org file to RSS.
204
205FILENAME is the filename of the Org file to be published.  PLIST
206is the property list for the given project.  PUB-DIR is the
207publishing directory.
208
209Return output file name."
210  (let ((bf (get-file-buffer filename)))
211    (if bf
212	  (with-current-buffer bf
213	    (org-icalendar-create-uid filename 'warn-user)
214	    (org-rss-add-pubdate-property)
215	    (write-file filename))
216      (find-file filename)
217      (org-icalendar-create-uid filename 'warn-user)
218      (org-rss-add-pubdate-property)
219      (write-file filename) (kill-buffer)))
220  (org-publish-org-to
221   'rss filename (concat "." org-rss-extension) plist pub-dir))
222
223;;; Main transcoding functions
224
225(defun org-rss-headline (headline contents info)
226  "Transcode HEADLINE element into RSS format.
227CONTENTS is the headline contents.  INFO is a plist used as a
228communication channel."
229  (unless (or (org-element-property :footnote-section-p headline)
230	      ;; Only consider first-level headlines
231	      (> (org-export-get-relative-level headline info) 1))
232    (let* ((author (and (plist-get info :with-author)
233			(let ((auth (plist-get info :author)))
234			  (and auth (org-export-data auth info)))))
235	   (htmlext (plist-get info :html-extension))
236	   (hl-number (org-export-get-headline-number headline info))
237	   (hl-home (file-name-as-directory (plist-get info :html-link-home)))
238	   (hl-pdir (plist-get info :publishing-directory))
239	   (hl-perm (org-element-property :RSS_PERMALINK headline))
240	   (anchor (org-export-get-reference headline info))
241	   (category (org-rss-plain-text
242		      (or (org-element-property :CATEGORY headline) "") info))
243	   (pubdate0 (org-element-property :PUBDATE headline))
244	   (pubdate (let ((system-time-locale "C"))
245		      (if pubdate0
246			  (format-time-string
247			   "%a, %d %b %Y %H:%M:%S %z"
248			   (org-time-string-to-time pubdate0)))))
249	   (title (or (org-element-property :RSS_TITLE headline)
250		      (replace-regexp-in-string
251		       org-bracket-link-regexp
252		       (lambda (m) (or (match-string 3 m)
253				  (match-string 1 m)))
254		       (org-element-property :raw-value headline))))
255	   (publink
256	    (or (and hl-perm (concat (or hl-home hl-pdir) hl-perm))
257		(concat
258		 (or hl-home hl-pdir)
259		 (file-name-nondirectory
260		  (file-name-sans-extension
261		   (plist-get info :input-file))) "." htmlext "#" anchor)))
262	   (guid (if org-rss-use-entry-url-as-guid
263		     publink
264		   (org-rss-plain-text
265		    (or (org-element-property :ID headline)
266			(org-element-property :CUSTOM_ID headline)
267			publink)
268		    info))))
269      (if (not pubdate0) "" ;; Skip entries with no PUBDATE prop
270	(format
271	 (concat
272	  "<item>\n"
273	  "<title>%s</title>\n"
274	  "<link>%s</link>\n"
275	  "<author>%s</author>\n"
276	  "<guid isPermaLink=\"false\">%s</guid>\n"
277	  "<pubDate>%s</pubDate>\n"
278	  (org-rss-build-categories headline info) "\n"
279	  "<description><![CDATA[%s]]></description>\n"
280	  "</item>\n")
281	 title publink author guid pubdate contents)))))
282
283(defun org-rss-build-categories (headline info)
284  "Build categories for the RSS item."
285  (if (eq (plist-get info :rss-categories) 'from-tags)
286      (mapconcat
287       (lambda (c) (format "<category><![CDATA[%s]]></category>" c))
288       (org-element-property :tags headline)
289       "\n")
290    (let ((c (org-element-property :CATEGORY headline)))
291      (format "<category><![CDATA[%s]]></category>" c))))
292
293(defun org-rss-template (contents info)
294  "Return complete document string after RSS conversion.
295CONTENTS is the transcoded contents string.  INFO is a plist used
296as a communication channel."
297  (concat
298   (format "<?xml version=\"1.0\" encoding=\"%s\"?>"
299	   (symbol-name org-html-coding-system))
300   "\n<rss version=\"2.0\"
301	xmlns:content=\"http://purl.org/rss/1.0/modules/content/\"
302	xmlns:wfw=\"http://wellformedweb.org/CommentAPI/\"
303	xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
304	xmlns:atom=\"http://www.w3.org/2005/Atom\"
305	xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\"
306	xmlns:slash=\"http://purl.org/rss/1.0/modules/slash/\"
307	xmlns:georss=\"http://www.georss.org/georss\"
308        xmlns:geo=\"http://www.w3.org/2003/01/geo/wgs84_pos#\"
309        xmlns:media=\"http://search.yahoo.com/mrss/\">"
310   "<channel>"
311   (org-rss-build-channel-info info) "\n"
312   contents
313   "</channel>\n"
314   "</rss>"))
315
316(defun org-rss-build-channel-info (info)
317  "Build the RSS channel information."
318  (let* ((system-time-locale "C")
319	 (title (plist-get info :title))
320	 (email (org-export-data (plist-get info :email) info))
321	 (author (and (plist-get info :with-author)
322		      (let ((auth (plist-get info :author)))
323			(and auth (org-export-data auth info)))))
324	 (date (format-time-string "%a, %d %b %Y %H:%M:%S %z")) ;; RFC 882
325	 (description (org-export-data (plist-get info :description) info))
326	 (lang (plist-get info :language))
327	 (keywords (plist-get info :keywords))
328	 (rssext (plist-get info :rss-extension))
329	 (blogurl (or (plist-get info :html-link-home)
330		      (plist-get info :publishing-directory)))
331	 (image (url-encode-url (plist-get info :rss-image-url)))
332	 (ifile (plist-get info :input-file))
333	 (publink
334	  (concat (file-name-as-directory blogurl)
335		  (file-name-nondirectory
336		   (file-name-sans-extension ifile))
337		  "." rssext)))
338    (format
339     "\n<title>%s</title>
340<atom:link href=\"%s\" rel=\"self\" type=\"application/rss+xml\" />
341<link>%s</link>
342<description><![CDATA[%s]]></description>
343<language>%s</language>
344<pubDate>%s</pubDate>
345<lastBuildDate>%s</lastBuildDate>
346<generator>%s</generator>
347<webMaster>%s (%s)</webMaster>
348<image>
349<url>%s</url>
350<title>%s</title>
351<link>%s</link>
352</image>
353"
354     title publink blogurl description lang date date
355     (concat (format "Emacs %d.%d"
356		     emacs-major-version
357		     emacs-minor-version)
358	     " Org-mode " (org-version))
359     email author image title blogurl)))
360
361(defun org-rss-section (section contents info)
362  "Transcode SECTION element into RSS format.
363CONTENTS is the section contents.  INFO is a plist used as
364a communication channel."
365  contents)
366
367(defun org-rss-timestamp (timestamp contents info)
368  "Transcode a TIMESTAMP object from Org to RSS.
369CONTENTS is nil.  INFO is a plist holding contextual
370information."
371  (org-html-encode-plain-text
372   (org-timestamp-translate timestamp)))
373
374(defun org-rss-plain-text (contents info)
375  "Convert plain text into RSS encoded text."
376  (let (output)
377    (setq output (org-html-encode-plain-text contents)
378	  output (org-export-activate-smart-quotes
379		  output :html info))))
380
381;;; Filters
382
383(defun org-rss-final-function (contents backend info)
384  "Prettify the RSS output."
385  (with-temp-buffer
386    (xml-mode)
387    (insert contents)
388    (indent-region (point-min) (point-max))
389    (buffer-substring-no-properties (point-min) (point-max))))
390
391;;; Miscellaneous
392
393(defun org-rss-add-pubdate-property ()
394  "Set the PUBDATE property for top-level headlines."
395  (let (msg)
396    (org-map-entries
397     (lambda ()
398       (let* ((entry (org-element-at-point))
399	      (level (org-element-property :level entry)))
400	 (when (= level 1)
401	   (unless (org-entry-get (point) "PUBDATE")
402	     (setq msg t)
403	     (org-set-property
404	      "PUBDATE" (format-time-string
405			 (cdr org-time-stamp-formats)))))))
406     nil nil 'comment 'archive)
407    (when msg
408      (message "Property PUBDATE added to top-level entries in %s"
409	       (buffer-file-name))
410      (sit-for 2))))
411
412(provide 'ox-rss)
413
414;;; ox-rss.el ends here