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