code.delx.au - gnu-emacs/blob - lisp/org/org-feed.el

   1 ;;; org-feed.el --- Add RSS feed items to Org files
   2 ;;
   3 ;; Copyright (C) 2009-2011 Free Software Foundation, Inc.
   4 ;;
   5 ;; Author: Carsten Dominik <carsten at orgmode dot org>
   6 ;; Keywords: outlines, hypermedia, calendar, wp
   7 ;; Homepage: http://orgmode.org
   8 ;; Version: 7.4
   9 ;;
  10 ;; This file is part of GNU Emacs.
  11 ;;
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;;  This module allows to create and change entries in an Org-mode
  29 ;;  file triggered by items in an RSS feed.  The basic functionality is
  30 ;;  geared toward simply adding new items found in a feed as outline nodes
  31 ;;  to an Org file.  Using hooks, arbitrary actions can be triggered for
  32 ;;  new or changed items.
  33 ;;
  34 ;;  Selecting feeds and target locations
  35 ;;  ------------------------------------
  36 ;;
  37 ;;  This module is configured through a single variable, `org-feed-alist'.
  38 ;;  Here is an example, using a notes/tasks feed from reQall.com.
  39 ;;
  40 ;;    (setq org-feed-alist
  41 ;;          '(("ReQall"
  42 ;;             "http://www.reqall.com/user/feeds/rss/a1b2c3....."
  43 ;;             "~/org/feeds.org" "ReQall Entries")
  44 ;;
  45 ;;  With this setup, the command `M-x org-feed-update-all' will
  46 ;;  collect new entries in the feed at the given URL and create
  47 ;;  entries as subheadings under the "ReQall Entries" heading in the
  48 ;;  file "~/org/feeds.org".  Each feed should normally have its own
  49 ;;  heading - however see the `:drawer' parameter.
  50 ;;
  51 ;;  Besides these standard elements that need to be specified for each
  52 ;;  feed, keyword-value pairs can set additional options.  For example,
  53 ;;  to de-select transitional entries with a title containing
  54 ;;
  55 ;;                   "reQall is typing what you said",
  56 ;;
  57 ;;  you could use the `:filter' argument:
  58 ;;
  59 ;;    (setq org-feed-alist
  60 ;;          '(("ReQall"
  61 ;;             "http://www.reqall.com/user/feeds/rss/a1b2c3....."
  62 ;;             "~/org/feeds.org" "ReQall Entries"
  63 ;;             :filter my-reqall-filter)))
  64 ;;
  65 ;;    (defun my-reqall-filter (e)
  66 ;;       (if (string-match "reQall is typing what you said"
  67 ;;                         (plist-get e :title))
  68 ;;           nil
  69 ;;         e))
  70 ;;
  71 ;;  See the docstring for `org-feed-alist' for more details.
  72 ;;
  73 ;;
  74 ;;  Keeping track of previously added entries
  75 ;;  -----------------------------------------
  76 ;;
  77 ;;  Since Org allows you to delete, archive, or move outline nodes,
  78 ;;  org-feed.el needs to keep track of which feed items have been handled
  79 ;;  before, so that they will not be handled again.  For this, org-feed.el
  80 ;;  stores information in a special drawer, FEEDSTATUS, under the heading
  81 ;;  that received the input of the feed.  You should add FEEDSTATUS
  82 ;;  to your list of drawers in the files that receive feed input:
  83 ;;
  84 ;;       #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS
  85 ;;
  86 ;;  Acknowledgments
  87 ;;  ---------------
  88 ;;
  89 ;;  org-feed.el is based on ideas by Brad Bozarth who implemented a
  90 ;;  similar mechanism using shell and awk scripts.
  91
  92 ;;; Code:
  93
  94 (require 'org)
  95 (require 'sha1)
  96
  97 (declare-function url-retrieve-synchronously "url" (url))
  98 (declare-function xml-node-children "xml" (node))
  99 (declare-function xml-get-children "xml" (node child-name))
 100 (declare-function xml-get-attribute "xml" (node attribute))
 101 (declare-function xml-get-attribute-or-nil "xml" (node attribute))
 102 (declare-function xml-substitute-special "xml" (string))
 103
 104 (defgroup org-feed  nil
 105   "Options concerning RSS feeds as inputs for Org files."
 106   :tag "Org Feed"
 107   :group 'org)
 108
 109 (defcustom org-feed-alist nil
 110   "Alist specifying RSS feeds that should create inputs for Org.
 111 Each entry in this list specified an RSS feed tat should be queried
 112 to create inbox items in Org.  Each entry is a list with the following items:
 113
 114 name         a custom name for this feed
 115 URL          the Feed URL
 116 file         the target Org file where entries should be listed
 117 headline     the headline under which entries should be listed
 118
 119 Additional arguments can be given using keyword-value pairs.  Many of these
 120 specify functions that receive one or a list of \"entries\" as their single
 121 argument.  An entry is a property list that describes a feed item.  The
 122 property list has properties for each field in the item, for example `:title'
 123 for the `<title>' field and `:pubDate' for the publication date.  In addition,
 124 it contains the following properties:
 125
 126 `:item-full-text'   the full text in the <item> tag
 127 `:guid-permalink'   t when the guid property is a permalink
 128
 129 Here are the keyword-value pair allows in `org-feed-alist'.
 130
 131 :drawer drawer-name
 132      The name of the drawer for storing feed information.  The default is
 133      \"FEEDSTATUS\".  Using different drawers for different feeds allows
 134      several feeds to target the same inbox heading.
 135
 136 :filter filter-function
 137      A function to select interesting entries in the feed.  It gets a single
 138      entry as parameter.  It should return the entry if it is relevant, or
 139      nil if it is not.
 140
 141 :template template-string
 142      The default action on new items in the feed is to add them as children
 143      under the headline for the feed.  The template describes how the entry
 144      should be formatted.  If not given, it defaults to
 145      `org-feed-default-template'.
 146
 147 :formatter formatter-function
 148      Instead of relying on a template, you may specify a function to format
 149      the outline node to be inserted as a child.  This function gets passed
 150      a property list describing a single feed item, and it should return a
 151      string that is a properly formatted Org outline node of level 1.
 152
 153 :new-handler function
 154      If adding new items as children to the outline is not what you want
 155      to do with new items, define a handler function that is called with
 156      a list of all new items in the feed, each one represented as a property
 157      list.  The handler should do what needs to be done, and org-feed will
 158      mark all items given to this handler as \"handled\", i.e. they will not
 159      be passed to this handler again in future readings of the feed.
 160      When the handler is called, point will be at the feed headline.
 161
 162 :changed-handler function
 163      This function gets passed a list of all entries that have been
 164      handled before, but are now still in the feed and have *changed*
 165      since last handled (as evidenced by a different sha1 hash).
 166      When the handler is called, point will be at the feed headline.
 167
 168 :parse-feed function
 169      This function gets passed a buffer, and should return a list
 170      of entries, each being a property list containing the
 171      `:guid' and `:item-full-text' keys.  The default is
 172      `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an
 173      alternative.
 174
 175 :parse-entry function
 176      This function gets passed an entry as returned by the parse-feed
 177      function, and should return the entry with interesting properties added.
 178      The default is `org-feed-parse-rss-entry'; `org-feed-parse-atom-entry'
 179      is an alternative."
 180   :group 'org-feed
 181   :type '(repeat
 182           (list :value ("" "http://" "" "")
 183            (string :tag "Name")
 184            (string :tag "Feed URL")
 185            (file :tag "File for inbox")
 186            (string :tag "Headline for inbox")
 187            (repeat :inline t
 188                    (choice
 189                     (list :inline t :tag "Filter"
 190                           (const :filter)
 191                           (symbol :tag "Filter Function"))
 192                     (list :inline t :tag "Template"
 193                           (const :template)
 194                           (string :tag "Template"))
 195                     (list :inline t :tag "Formatter"
 196                           (const :formatter)
 197                           (symbol :tag "Formatter Function"))
 198                     (list :inline t :tag "New items handler"
 199                           (const :new-handler)
 200                           (symbol :tag "Handler Function"))
 201                     (list :inline t :tag "Changed items"
 202                           (const :changed-handler)
 203                           (symbol :tag "Handler Function"))
 204                     (list :inline t :tag "Parse Feed"
 205                           (const :parse-feed)
 206                           (symbol :tag "Parse Feed Function"))
 207                     (list :inline t :tag "Parse Entry"
 208                           (const :parse-entry)
 209                           (symbol :tag "Parse Entry Function"))
 210                     )))))
 211
 212 (defcustom org-feed-drawer "FEEDSTATUS"
 213   "The name of the drawer for feed status information.
 214 Each feed may also specify its own drawer name using the `:drawer'
 215 parameter in `org-feed-alist'.
 216 Note that in order to make these drawers behave like drawers, they must
 217 be added to the variable `org-drawers' or configured with a #+DRAWERS
 218 line."
 219   :group 'org-feed
 220   :type '(string :tag "Drawer Name"))
 221
 222 (defcustom org-feed-default-template "\n* %h\n  %U\n  %description\n  %a\n"
 223   "Template for the Org node created from RSS feed items.
 224 This is just the default, each feed can specify its own.
 225 Any fields from the feed item can be interpolated into the template with
 226 %name, for example %title, %description, %pubDate etc.  In addition, the
 227 following special escapes are valid as well:
 228
 229 %h      the title, or the first line of the description
 230 %t      the date as a stamp, either from <pubDate> (if present), or
 231         the current date.
 232 %T      date and time
 233 %u,%U   like %t,%T, but inactive time stamps
 234 %a      A link, from <guid> if that is a permalink, else from <link>"
 235   :group 'org-feed
 236   :type '(string :tag "Template"))
 237
 238 (defcustom org-feed-save-after-adding t
 239   "Non-nil means save buffer after adding new feed items."
 240   :group 'org-feed
 241   :type 'boolean)
 242
 243 (defcustom org-feed-retrieve-method 'url-retrieve-synchronously
 244   "The method to be used to retrieve a feed URL.
 245 This can be `curl' or `wget' to call these external programs, or it can be
 246 an Emacs Lisp function that will return a buffer containing the content
 247 of the file pointed to by the URL."
 248   :group 'org-feed
 249   :type '(choice
 250           (const :tag "Internally with url.el" url-retrieve-synchronously)
 251           (const :tag "Externally with curl" curl)
 252           (const :tag "Externally with wget" wget)
 253           (function :tag "Function")))
 254
 255  (defcustom org-feed-before-adding-hook nil
 256   "Hook that is run before adding new feed items to a file.
 257 You might want to commit the file in its current state to version control,
 258 for example."
 259   :group 'org-feed
 260   :type 'hook)
 261
 262 (defcustom org-feed-after-adding-hook nil
 263   "Hook that is run after new items have been added to a file.
 264 Depending on `org-feed-save-after-adding', the buffer will already
 265 have been saved."
 266   :group 'org-feed
 267   :type 'hook)
 268
 269 (defvar org-feed-buffer "*Org feed*"
 270   "The buffer used to retrieve a feed.")
 271
 272 ;;;###autoload
 273 (defun org-feed-update-all ()
 274   "Get inbox items from all feeds in `org-feed-alist'."
 275   (interactive)
 276   (let ((nfeeds (length org-feed-alist))
 277         (nnew (apply '+  (mapcar 'org-feed-update org-feed-alist))))
 278     (message "%s from %d %s"
 279              (cond ((= nnew 0) "No new entries")
 280                    ((= nnew 1) "1 new entry")
 281                    (t (format "%d new entries" nnew)))
 282              nfeeds
 283              (if (= nfeeds 1) "feed" "feeds"))))
 284
 285 ;;;###autoload
 286 (defun org-feed-update (feed &optional retrieve-only)
 287   "Get inbox items from FEED.
 288 FEED can be a string with an association in `org-feed-alist', or
 289 it can be a list structured like an entry in `org-feed-alist'."
 290   (interactive (list (org-completing-read "Feed name: " org-feed-alist)))
 291   (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
 292   (unless feed
 293     (error "No such feed in `org-feed-alist"))
 294   (catch 'exit
 295     (let ((name (car feed))
 296           (url (nth 1 feed))
 297           (file (nth 2 feed))
 298           (headline (nth 3 feed))
 299           (filter (nth 1 (memq :filter feed)))
 300           (formatter (nth 1 (memq :formatter feed)))
 301           (new-handler (nth 1 (memq :new-handler feed)))
 302           (changed-handler (nth 1 (memq :changed-handler feed)))
 303           (template (or (nth 1 (memq :template feed))
 304                         org-feed-default-template))
 305           (drawer (or (nth 1 (memq :drawer feed))
 306                       org-feed-drawer))
 307           (parse-feed (or (nth 1 (memq :parse-feed feed))
 308                           'org-feed-parse-rss-feed))
 309           (parse-entry (or (nth 1 (memq :parse-entry feed))
 310                            'org-feed-parse-rss-entry))
 311           feed-buffer inbox-pos new-formatted
 312           entries old-status status new changed guid-alist e guid olds)
 313       (setq feed-buffer (org-feed-get-feed url))
 314       (unless (and feed-buffer (bufferp (get-buffer feed-buffer)))
 315         (error "Cannot get feed %s" name))
 316       (when retrieve-only
 317         (throw 'exit feed-buffer))
 318       (setq entries (funcall parse-feed feed-buffer))
 319       (ignore-errors (kill-buffer feed-buffer))
 320       (save-excursion
 321         (save-window-excursion
 322           (setq inbox-pos (org-feed-goto-inbox-internal file headline))
 323           (setq old-status (org-feed-read-previous-status inbox-pos drawer))
 324           ;; Add the "handled" status to the appropriate entries
 325           (setq entries (mapcar (lambda (e)
 326                                   (setq e
 327                                         (plist-put e :handled
 328                                                    (nth 1 (assoc
 329                                                            (plist-get e :guid)
 330                                                            old-status)))))
 331                                 entries))
 332           ;; Find out which entries are new and which are changed
 333           (dolist (e entries)
 334             (if (not (plist-get e :handled))
 335                 (push e new)
 336               (setq olds (nth 2 (assoc (plist-get e :guid) old-status)))
 337               (if (and olds
 338                        (not (string= (sha1
 339                                       (plist-get e :item-full-text))
 340                                      olds)))
 341                   (push e changed))))
 342
 343           ;; Parse the relevant entries fully
 344           (setq new     (mapcar parse-entry new)
 345                 changed (mapcar parse-entry changed))
 346
 347           ;; Run the filter
 348           (when filter
 349             (setq new     (delq nil (mapcar filter new))
 350                   changed (delq nil (mapcar filter new))))
 351
 352           (when (not (or new changed))
 353             (message "No new items in feed %s" name)
 354             (throw 'exit 0))
 355
 356           ;; Get alist based on guid, to look up entries
 357           (setq guid-alist
 358                 (append
 359                  (mapcar (lambda (e) (list (plist-get e :guid) e)) new)
 360                  (mapcar (lambda (e) (list (plist-get e :guid) e)) changed)))
 361
 362           ;; Construct the new status
 363           (setq status
 364                 (mapcar
 365                  (lambda (e)
 366                    (setq guid (plist-get e :guid))
 367                    (list guid
 368                          ;; things count as handled if we handle them now,
 369                          ;; or if they were handled previously
 370                          (if (assoc guid guid-alist) t (plist-get e :handled))
 371                          ;; A hash, to detect changes
 372                          (sha1 (plist-get e :item-full-text))))
 373                  entries))
 374
 375           ;; Handle new items in the feed
 376           (when new
 377             (if new-handler
 378                 (progn
 379                   (goto-char inbox-pos)
 380                   (funcall new-handler new))
 381               ;; No custom handler, do the default adding
 382               ;; Format the new entries into an alist with GUIDs in the car
 383               (setq new-formatted
 384                     (mapcar
 385                      (lambda (e) (org-feed-format-entry e template formatter))
 386                      new)))
 387
 388             ;; Insert the new items
 389             (org-feed-add-items inbox-pos new-formatted))
 390
 391           ;; Handle changed items in the feed
 392           (when (and changed-handler changed)
 393             (goto-char inbox-pos)
 394             (funcall changed-handler changed))
 395
 396           ;; Write the new status
 397           ;; We do this only now, in case something goes wrong above, so
 398           ;; that would would end up with a status that does not reflect
 399           ;; which items truely have been handled
 400           (org-feed-write-status inbox-pos drawer status)
 401
 402           ;; Normalize the visibility of the inbox tree
 403           (goto-char inbox-pos)
 404           (hide-subtree)
 405           (show-children)
 406           (org-cycle-hide-drawers 'children)
 407
 408           ;; Hooks and messages
 409           (when org-feed-save-after-adding (save-buffer))
 410           (message "Added %d new item%s from feed %s to file %s, heading %s"
 411                    (length new) (if (> (length new) 1) "s" "")
 412                    name
 413                    (file-name-nondirectory file) headline)
 414           (run-hooks 'org-feed-after-adding-hook)
 415           (length new))))))
 416
 417 ;;;###autoload
 418 (defun org-feed-goto-inbox (feed)
 419   "Go to the inbox that captures the feed named FEED."
 420   (interactive
 421    (list (if (= (length org-feed-alist) 1)
 422              (car org-feed-alist)
 423            (org-completing-read "Feed name: " org-feed-alist))))
 424   (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
 425   (unless feed
 426     (error "No such feed in `org-feed-alist"))
 427   (org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed)))
 428
 429 ;;;###autoload
 430 (defun org-feed-show-raw-feed (feed)
 431   "Show the raw feed buffer of a feed."
 432   (interactive
 433    (list (if (= (length org-feed-alist) 1)
 434              (car org-feed-alist)
 435            (org-completing-read "Feed name: " org-feed-alist))))
 436   (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
 437   (unless feed
 438     (error "No such feed in `org-feed-alist"))
 439   (switch-to-buffer
 440    (org-feed-update feed 'retrieve-only))
 441   (goto-char (point-min)))
 442
 443 (defun org-feed-goto-inbox-internal (file heading)
 444   "Find or create HEADING in FILE.
 445 Switch to that buffer, and return the position of that headline."
 446   (find-file file)
 447   (widen)
 448   (goto-char (point-min))
 449   (if (re-search-forward
 450        (concat "^\\*+[ \t]+" heading "[ \t]*\\(:.*?:[ \t]*\\)?$")
 451        nil t)
 452       (goto-char (match-beginning 0))
 453     (goto-char (point-max))
 454       (insert "\n\n* " heading "\n\n")
 455       (org-back-to-heading t))
 456   (point))
 457
 458 (defun org-feed-read-previous-status (pos drawer)
 459   "Get the alist of old GUIDs from the entry at POS.
 460 This will find DRAWER and extract the alist."
 461   (save-excursion
 462     (goto-char pos)
 463     (let ((end (save-excursion (org-end-of-subtree t t))))
 464       (if (re-search-forward
 465            (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:")
 466            end t)
 467           (read (match-string 1))
 468         nil))))
 469
 470 (defun org-feed-write-status (pos drawer status)
 471   "Write the feed STATUS to DRAWER in entry at POS."
 472   (save-excursion
 473     (goto-char pos)
 474     (let ((end (save-excursion (org-end-of-subtree t t)))
 475           guid)
 476       (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n")
 477                              end t)
 478           (progn
 479             (goto-char (match-end 0))
 480             (delete-region (point)
 481                            (save-excursion
 482                              (and (re-search-forward "^[ \t]*:END:" nil t)
 483                                   (match-beginning 0)))))
 484         (outline-next-heading)
 485         (insert "  :" drawer ":\n  :END:\n")
 486         (beginning-of-line 0))
 487       (insert (pp-to-string status)))))
 488
 489 (defun org-feed-add-items (pos entries)
 490   "Add the formatted items to the headline as POS."
 491   (let (entry level)
 492     (save-excursion
 493       (goto-char pos)
 494       (unless (looking-at org-complex-heading-regexp)
 495         (error "Wrong position"))
 496       (setq level (org-get-valid-level (length (match-string 1)) 1))
 497       (org-end-of-subtree t t)
 498       (skip-chars-backward " \t\n")
 499       (beginning-of-line 2)
 500       (setq pos (point))
 501       (while (setq entry (pop entries))
 502         (org-paste-subtree level entry 'yank))
 503       (org-mark-ring-push pos))))
 504
 505 (defun org-feed-format-entry (entry template formatter)
 506   "Format ENTRY so that it can be inserted into an Org file.
 507 ENTRY is a property list.  This function adds a `:formatted-for-org' property
 508 and returns the full property list.
 509 If that property is already present, nothing changes."
 510   (if formatter
 511       (funcall formatter entry)
 512     (let (dlines fmt tmp indent time name
 513                  v-h v-t v-T v-u v-U v-a)
 514       (setq dlines (org-split-string (or (plist-get entry :description) "???")
 515                                      "\n")
 516             v-h (or (plist-get entry :title) (car dlines) "???")
 517             time (or (if (plist-get entry :pubDate)
 518                          (org-read-date t t (plist-get entry :pubDate)))
 519                      (current-time))
 520             v-t (format-time-string (org-time-stamp-format nil nil) time)
 521             v-T (format-time-string (org-time-stamp-format t   nil) time)
 522             v-u (format-time-string (org-time-stamp-format nil t)   time)
 523             v-U (format-time-string (org-time-stamp-format t   t)   time)
 524             v-a (if (setq tmp (or (and (plist-get entry :guid-permalink)
 525                                        (plist-get entry :guid))
 526                                   (plist-get entry :link)))
 527                     (concat "[[" tmp "]]\n")
 528                   ""))
 529       (with-temp-buffer
 530         (insert template)
 531         (goto-char (point-min))
 532         (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
 533           (setq name (match-string 1))
 534           (cond
 535            ((member name '("h" "t" "T" "u" "U" "a"))
 536             (replace-match (symbol-value (intern (concat "v-" name))) t t))
 537            ((setq tmp (plist-get entry (intern (concat ":" name))))
 538             (save-excursion
 539               (save-match-data
 540                 (beginning-of-line 1)
 541                 (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
 542                   (setq tmp (org-feed-make-indented-block
 543                              tmp (org-get-indentation))))))
 544             (replace-match tmp t t))))
 545         (decode-coding-string
 546          (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
 547
 548 (defun org-feed-make-indented-block (s n)
 549   "Add indentation of N spaces to a multiline string S."
 550   (if (not (string-match "\n" s))
 551       s
 552     (mapconcat 'identity
 553                (org-split-string s "\n")
 554                (concat "\n" (make-string n ?\ )))))
 555
 556 (defun org-feed-skip-http-headers (buffer)
 557   "Remove HTTP headers from BUFFER, and return it.
 558 Assumes headers are indeed present!"
 559   (with-current-buffer buffer
 560     (widen)
 561     (goto-char (point-min))
 562     (search-forward "\n\n")
 563     (delete-region (point-min) (point))
 564     buffer))
 565
 566 (defun org-feed-get-feed (url)
 567   "Get the RSS feed file at URL and return the buffer."
 568   (cond
 569    ((eq org-feed-retrieve-method 'url-retrieve-synchronously)
 570     (org-feed-skip-http-headers (url-retrieve-synchronously url)))
 571    ((eq org-feed-retrieve-method 'curl)
 572     (ignore-errors (kill-buffer org-feed-buffer))
 573     (call-process "curl" nil org-feed-buffer nil "--silent" url)
 574     org-feed-buffer)
 575    ((eq org-feed-retrieve-method 'wget)
 576     (ignore-errors (kill-buffer org-feed-buffer))
 577     (call-process "wget" nil org-feed-buffer nil "-q" "-O" "-" url)
 578     org-feed-buffer)
 579    ((functionp org-feed-retrieve-method)
 580     (funcall org-feed-retrieve-method url))))
 581
 582 (defun org-feed-parse-rss-feed (buffer)
 583   "Parse BUFFER for RSS feed entries.
 584 Returns a list of entries, with each entry a property list,
 585 containing the properties `:guid' and `:item-full-text'."
 586   (let ((case-fold-search t)
 587         entries beg end item guid entry)
 588     (with-current-buffer buffer
 589       (widen)
 590       (goto-char (point-min))
 591       (while (re-search-forward "<item\\>.*?>" nil t)
 592         (setq beg (point)
 593               end (and (re-search-forward "</item>" nil t)
 594                        (match-beginning 0)))
 595         (setq item (buffer-substring beg end)
 596               guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item)
 597                        (org-match-string-no-properties 1 item)))
 598         (setq entry (list :guid guid :item-full-text item))
 599         (push entry entries)
 600         (widen)
 601         (goto-char end))
 602       (nreverse entries))))
 603
 604 (defun org-feed-parse-rss-entry (entry)
 605   "Parse the `:item-full-text' field for xml tags and create new properties."
 606   (require 'xml)
 607   (with-temp-buffer
 608     (insert (plist-get entry :item-full-text))
 609     (goto-char (point-min))
 610     (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>"
 611                               nil t)
 612       (setq entry (plist-put entry
 613                              (intern (concat ":" (match-string 1)))
 614                              (xml-substitute-special (match-string 2)))))
 615     (goto-char (point-min))
 616     (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t)
 617       (setq entry (plist-put entry :guid-permalink t))))
 618   entry)
 619
 620 (defun org-feed-parse-atom-feed (buffer)
 621   "Parse BUFFER for Atom feed entries.
 622 Returns a list of entries, with each entry a property list,
 623 containing the properties `:guid' and `:item-full-text'.
 624
 625 The `:item-full-text' property actually contains the sexp
 626 formatted as a string, not the original XML data."
 627   (require 'xml)
 628   (with-current-buffer buffer
 629     (widen)
 630     (let ((feed (car (xml-parse-region (point-min) (point-max)))))
 631       (mapcar
 632        (lambda (entry)
 633          (list
 634           :guid (car (xml-node-children (car (xml-get-children entry 'id))))
 635           :item-full-text (prin1-to-string entry)))
 636        (xml-get-children feed 'entry)))))
 637
 638 (defun org-feed-parse-atom-entry (entry)
 639   "Parse the `:item-full-text' as a sexp and create new properties."
 640   (let ((xml (car (read-from-string (plist-get entry :item-full-text)))))
 641     ;; Get first <link href='foo'/>.
 642     (setq entry (plist-put entry :link
 643                            (xml-get-attribute
 644                             (car (xml-get-children xml 'link))
 645                             'href)))
 646     ;; Add <title/> as :title.
 647     (setq entry (plist-put entry :title
 648                            (xml-substitute-special
 649                             (car (xml-node-children
 650                                   (car (xml-get-children xml 'title)))))))
 651     (let* ((content (car (xml-get-children xml 'content)))
 652            (type (xml-get-attribute-or-nil content 'type)))
 653       (when content
 654         (cond
 655          ((string= type "text")
 656           ;; We like plain text.
 657           (setq entry (plist-put entry :description
 658                                  (xml-substitute-special
 659                                   (car (xml-node-children content))))))
 660          ((string= type "html")
 661           ;; TODO: convert HTML to Org markup.
 662           (setq entry (plist-put entry :description
 663                                  (xml-substitute-special
 664                                   (car (xml-node-children content))))))
 665          ((string= type "xhtml")
 666           ;; TODO: convert XHTML to Org markup.
 667           (setq entry (plist-put entry :description
 668                                  (prin1-to-string
 669                                   (xml-node-children content)))))
 670          (t
 671           (setq entry (plist-put entry :description
 672                                  (format "Unknown '%s' content." type)))))))
 673     entry))
 674
 675 (provide 'org-feed)
 676
 677 ;;; org-feed.el ends here