X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/2db38a6f98c2abb42b746064ce97417cccc27e68..c7e9ed79544f1715b288eb5795963d4b5d8f1ff0:/lisp/org/org-feed.el diff --git a/lisp/org/org-feed.el b/lisp/org/org-feed.el index df1e187e40..f5186aaacf 100644 --- a/lisp/org/org-feed.el +++ b/lisp/org/org-feed.el @@ -1,11 +1,10 @@ ;;; org-feed.el --- Add RSS feed items to Org files ;; -;; Copyright (C) 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2009-2012 Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.33x ;; ;; This file is part of GNU Emacs. ;; @@ -45,7 +44,7 @@ ;; With this setup, the command `M-x org-feed-update-all' will ;; collect new entries in the feed at the given URL and create ;; entries as subheadings under the "ReQall Entries" heading in the -;; file "~/org-feeds.org". Each feed should normally have its own +;; file "~/org/feeds.org". Each feed should normally have its own ;; heading - however see the `:drawer' parameter. ;; ;; Besides these standard elements that need to be specified for each @@ -83,8 +82,8 @@ ;; ;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS ;; -;; Acknowledgements -;; ---------------- +;; Acknowledgments +;; --------------- ;; ;; org-feed.el is based on ideas by Brad Bozarth who implemented a ;; similar mechanism using shell and awk scripts. @@ -99,10 +98,11 @@ (declare-function xml-get-children "xml" (node child-name)) (declare-function xml-get-attribute "xml" (node attribute)) (declare-function xml-get-attribute-or-nil "xml" (node attribute)) +(declare-function xml-substitute-special "xml" (string)) (defgroup org-feed nil "Options concerning RSS feeds as inputs for Org files." - :tag "Org ID" + :tag "Org Feed" :group 'org) (defcustom org-feed-alist nil @@ -165,10 +165,11 @@ Here are the keyword-value pair allows in `org-feed-alist'. When the handler is called, point will be at the feed headline. :parse-feed function - This function gets passed a buffer, and should return a list of entries, - each being a property list containing the `:guid' and `:item-full-text' - keys. The default is `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' - is an alternative. + This function gets passed a buffer, and should return a list + of entries, each being a property list containing the + `:guid' and `:item-full-text' keys. The default is + `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an + alternative. :parse-entry function This function gets passed an entry as returned by the parse-feed @@ -199,12 +200,12 @@ Here are the keyword-value pair allows in `org-feed-alist'. (list :inline t :tag "Changed items" (const :changed-handler) (symbol :tag "Handler Function")) - (list :inline t :tag "Parse Feed" - (const :parse-feed) - (symbol :tag "Parse Feed Function")) - (list :inline t :tag "Parse Entry" - (const :parse-entry) - (symbol :tag "Parse Entry Function")) + (list :inline t :tag "Parse Feed" + (const :parse-feed) + (symbol :tag "Parse Feed Function")) + (list :inline t :tag "Parse Entry" + (const :parse-entry) + (symbol :tag "Parse Entry Function")) ))))) (defcustom org-feed-drawer "FEEDSTATUS" @@ -234,7 +235,7 @@ following special escapes are valid as well: :type '(string :tag "Template")) (defcustom org-feed-save-after-adding t - "Non-nil means, save buffer after adding new feed items." + "Non-nil means save buffer after adding new feed items." :group 'org-feed :type 'boolean) @@ -302,10 +303,10 @@ it can be a list structured like an entry in `org-feed-alist'." org-feed-default-template)) (drawer (or (nth 1 (memq :drawer feed)) org-feed-drawer)) - (parse-feed (or (nth 1 (memq :parse-feed feed)) - 'org-feed-parse-rss-feed)) - (parse-entry (or (nth 1 (memq :parse-entry feed)) - 'org-feed-parse-rss-entry)) + (parse-feed (or (nth 1 (memq :parse-feed feed)) + 'org-feed-parse-rss-feed)) + (parse-entry (or (nth 1 (memq :parse-entry feed)) + 'org-feed-parse-rss-entry)) feed-buffer inbox-pos new-formatted entries old-status status new changed guid-alist e guid olds) (setq feed-buffer (org-feed-get-feed url)) @@ -321,10 +322,11 @@ it can be a list structured like an entry in `org-feed-alist'." (setq old-status (org-feed-read-previous-status inbox-pos drawer)) ;; Add the "handled" status to the appropriate entries (setq entries (mapcar (lambda (e) - (setq e (plist-put e :handled - (nth 1 (assoc - (plist-get e :guid) - old-status))))) + (setq e + (plist-put e :handled + (nth 1 (assoc + (plist-get e :guid) + old-status))))) entries)) ;; Find out which entries are new and which are changed (dolist (e entries) @@ -433,7 +435,7 @@ it can be a list structured like an entry in `org-feed-alist'." (if (stringp feed) (setq feed (assoc feed org-feed-alist))) (unless feed (error "No such feed in `org-feed-alist")) - (switch-to-buffer + (org-pop-to-buffer-same-window (org-feed-update feed 'retrieve-only)) (goto-char (point-min))) @@ -539,7 +541,8 @@ If that property is already present, nothing changes." (setq tmp (org-feed-make-indented-block tmp (org-get-indentation)))))) (replace-match tmp t t)))) - (buffer-string))))) + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) (defun org-feed-make-indented-block (s n) "Add indentation of N spaces to a multiline string S." @@ -579,11 +582,12 @@ Assumes headers are indeed present!" "Parse BUFFER for RSS feed entries. Returns a list of entries, with each entry a property list, containing the properties `:guid' and `:item-full-text'." - (let (entries beg end item guid entry) + (let ((case-fold-search t) + entries beg end item guid entry) (with-current-buffer buffer (widen) (goto-char (point-min)) - (while (re-search-forward "" nil t) + (while (re-search-forward ".*?>" nil t) (setq beg (point) end (and (re-search-forward "" nil t) (match-beginning 0))) @@ -598,6 +602,7 @@ containing the properties `:guid' and `:item-full-text'." (defun org-feed-parse-rss-entry (entry) "Parse the `:item-full-text' field for xml tags and create new properties." + (require 'xml) (with-temp-buffer (insert (plist-get entry :item-full-text)) (goto-char (point-min)) @@ -605,7 +610,7 @@ containing the properties `:guid' and `:item-full-text'." nil t) (setq entry (plist-put entry (intern (concat ":" (match-string 1))) - (match-string 2)))) + (xml-substitute-special (match-string 2))))) (goto-char (point-min)) (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) (setq entry (plist-put entry :guid-permalink t)))) @@ -618,14 +623,15 @@ containing the properties `:guid' and `:item-full-text'. The `:item-full-text' property actually contains the sexp formatted as a string, not the original XML data." + (require 'xml) (with-current-buffer buffer (widen) (let ((feed (car (xml-parse-region (point-min) (point-max))))) (mapcar (lambda (entry) - (list - :guid (car (xml-node-children (car (xml-get-children entry 'id)))) - :item-full-text (prin1-to-string entry))) + (list + :guid (car (xml-node-children (car (xml-get-children entry 'id)))) + :item-full-text (prin1-to-string entry))) (xml-get-children feed 'entry))))) (defun org-feed-parse-atom-entry (entry) @@ -633,31 +639,38 @@ formatted as a string, not the original XML data." (let ((xml (car (read-from-string (plist-get entry :item-full-text))))) ;; Get first . (setq entry (plist-put entry :link - (xml-get-attribute - (car (xml-get-children xml 'link)) - 'href))) + (xml-get-attribute + (car (xml-get-children xml 'link)) + 'href))) ;; Add as :title. (setq entry (plist-put entry :title - (car (xml-node-children - (car (xml-get-children xml 'title)))))) + (xml-substitute-special + (car (xml-node-children + (car (xml-get-children xml 'title))))))) (let* ((content (car (xml-get-children xml 'content))) - (type (xml-get-attribute-or-nil content 'type))) + (type (xml-get-attribute-or-nil content 'type))) (when content - (cond - ((string= type "text") - ;; We like plain text. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "html") - ;; TODO: convert HTML to Org markup. - (setq entry (plist-put entry :description (car (xml-node-children content))))) - ((string= type "xhtml") - ;; TODO: convert XHTML to Org markup. - (setq entry (plist-put entry :description (prin1-to-string (xml-node-children content))))) - (t - (setq entry (plist-put entry :description (format "Unknown '%s' content." type))))))) + (cond + ((string= type "text") + ;; We like plain text. + (setq entry (plist-put entry :description + (xml-substitute-special + (car (xml-node-children content)))))) + ((string= type "html") + ;; TODO: convert HTML to Org markup. + (setq entry (plist-put entry :description + (xml-substitute-special + (car (xml-node-children content)))))) + ((string= type "xhtml") + ;; TODO: convert XHTML to Org markup. + (setq entry (plist-put entry :description + (prin1-to-string + (xml-node-children content))))) + (t + (setq entry (plist-put entry :description + (format "Unknown '%s' content." type))))))) entry)) (provide 'org-feed) -;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2 ;;; org-feed.el ends here