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