mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-11-26 07:33:39 +00:00
org-feed.el: re-written
This commit is contained in:
Carsten Dominik
parent
ae1e7894c0
commit
72908042c3
@ -1,5 +1,7 @@
|
||||
2009-03-25 Carsten Dominik <carsten.dominik@gmail.com>
|
||||
|
||||
* org-feed.el: Re-write.
|
||||
|
||||
* org-agenda.el (org-agenda-get-todos): Fix bug with match-data.
|
||||
(org-agenda-get-todos): Mark file tags as inherited.
|
||||
(org-agenda-list): Always search diary lines for a time.
|
||||
|
||||
285
lisp/org-feed.el
285
lisp/org-feed.el
@ -44,9 +44,9 @@
|
||||
;; entries as subheadings under the "ReQall Entries" heading in the
|
||||
;; file "~/org.feeds.org".
|
||||
;; In addition to these standard arguments, additional keyword-value
|
||||
;; pairs are possible. For example, here we turn entries with
|
||||
;; "<category>Task</category>" into TODO entries by adding the
|
||||
;; keyword to the title, usinf the `:filter' argument:
|
||||
;; pairs are possible. For example, here we deselect entries with
|
||||
;; a description containing "Reqall is typing" using the `:filter'
|
||||
;; argument:
|
||||
;;
|
||||
;; (setq org-feed-alist
|
||||
;; '(("ReQall"
|
||||
@ -54,41 +54,28 @@
|
||||
;; "~/org/feeds.org" "ReQall Entries"
|
||||
;; :filter my-reqall-filter)))
|
||||
;;
|
||||
;; (defun my-reqall-filter (e)
|
||||
;; (when (equal (plist-get e :category) "Task")
|
||||
;; (setq e (plist-put e :title
|
||||
;; (concat "TODO " (plist-get e :title)))))
|
||||
;; e)
|
||||
;; (defun my-reqall-filter (e)
|
||||
;; (if (string-match "Reqall is typing" (plist-get e :description))
|
||||
;; nil
|
||||
;; e)
|
||||
;;
|
||||
;; A `:template' entry in the alist would override the template
|
||||
;; in `org-feed-default-template' for the construction of the outline
|
||||
;; node to be inserted. Another possibility would be for the filter
|
||||
;; function to create the Org node for the feed item, by adding the
|
||||
;; formatted entry as a `:formatted-for-org' property:
|
||||
;; node to be inserted. You may also write your own function to format
|
||||
;; the entry and specify it using the `:formatter' keyword.
|
||||
;;
|
||||
;; (defun my-reqall-filter (e)
|
||||
;; (setq e (plist-put
|
||||
;; e :formatted-for-org
|
||||
;; (format "* %s\n%s"
|
||||
;; (plist-get e :title)
|
||||
;; (plist-get e :description))))
|
||||
;; e)
|
||||
;;
|
||||
;; The filter function may also decide that certain feed items
|
||||
;; should be ignored, by returning nil instead of the entry.
|
||||
;;
|
||||
;;
|
||||
;; Keeping track of old GUIDs
|
||||
;; --------------------------
|
||||
;; Keeping track of previously added entries
|
||||
;; -----------------------------------------
|
||||
;;
|
||||
;; Since Org allows you to delete, archive, or move outline nodes,
|
||||
;; org-feed.el needs to keep track of GUIDs in the feed it has
|
||||
;; already processed. It does so by listing them in a special
|
||||
;; drawer, FEEDGUIDS, under the heading that received the input of
|
||||
;; the feed. You should add FEEDGUIDS to your list of drawers
|
||||
;; in the files that receive feed input:
|
||||
;; org-feed.el needs to keep track of which feed items have been added
|
||||
;; before, so that they will not be added again. For this, org-feed.el
|
||||
;; stores information in a special drawer, FEEDSTATUS, under the heading
|
||||
;; that received the input of the feed. For this reason, each feed must
|
||||
;; have its own headline in an Org file. You should add FEEDSTATUS
|
||||
;; to your list of drawers in the files that receive feed input:
|
||||
;;
|
||||
;; #+DRAWERS: PROPERTIES LOGBOOK FEEDGUIDS
|
||||
;; #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS
|
||||
;;
|
||||
;; Acknowledgements
|
||||
;; ----------------
|
||||
@ -124,17 +111,17 @@ headline the headline under which entries should be listed
|
||||
|
||||
Additional argumetns can be given using keyword-value pairs:
|
||||
|
||||
:template template-string
|
||||
The template to create an Org node from a feed item
|
||||
|
||||
:filter filter-function
|
||||
A function to filter entries before Org nodes are
|
||||
created from them.
|
||||
|
||||
If no template is given, the one in `org-feed-default-template' is used.
|
||||
See the docstring of that variable for information on the syntax of this
|
||||
template. If creating the node required more logic than a template can
|
||||
provide, this task can be delegated to the filter function.
|
||||
:template template-string
|
||||
The template to create an Org node from a feed item.
|
||||
For more control, use the `:formatter'.
|
||||
|
||||
:formatter formatter-function
|
||||
A function to filter entries before Org nodes are
|
||||
created from them.
|
||||
|
||||
The filter function gets as a argument a property list describing the item.
|
||||
That list has a property for each field, for example `:title' for the
|
||||
@ -144,14 +131,18 @@ it contains the following properties:
|
||||
`:item-full-text' the full text in the <item> tag
|
||||
`:guid-permalink' t when the guid property is a permalink
|
||||
|
||||
The filter function can modify the existing fields before an item
|
||||
is constructed using the template. Or it can construct the node directly,
|
||||
by adding a `:formatted-for-org' property that specifies the complete
|
||||
outline node that should be added.
|
||||
The filter function should do only one thing: decide whether this entry
|
||||
is worth being added now to the Org file. The filter does not need to worry
|
||||
if the entry was added in the past, just decide if this is a junk entry,
|
||||
or something useful. Entries with a given GUID will be added only once,
|
||||
the first time they pass the filter.
|
||||
|
||||
The filter should return the modified entry property list. It may also
|
||||
return nil to indicate that this entry should not be added to the Org file
|
||||
at all."
|
||||
Entries will be turned onto Org nodes acccording to a template. If no
|
||||
template is given here, `org-feed-default-template' is used. See the
|
||||
docstring of that variable for information on the template syntax. If
|
||||
creating the node requires more logic than a template can provide, define a
|
||||
:formatter function that will take an entry and return the formatted Org
|
||||
node as a string."
|
||||
:group 'org-feed
|
||||
:type '(repeat
|
||||
(list :value ("" "http://" "" "")
|
||||
@ -164,9 +155,12 @@ at all."
|
||||
(list :inline t :tag "Template"
|
||||
(const :template) (string :tag "Template"))
|
||||
(list :inline t :tag "Filter"
|
||||
(const :filter) (symbol :tag "Filter Function")))))))
|
||||
(const :filter) (symbol :tag "Filter Function"))
|
||||
(list :inline t :tag "Formatter"
|
||||
(const :filter) (symbol :tag "Formatter Function"))
|
||||
)))))
|
||||
|
||||
(defcustom org-feed-default-template "* %h\n %U\n %description\n %a\n"
|
||||
(defcustom org-feed-default-template "\n* %h\n %U\n %description\n %a\n"
|
||||
"Template for the Org node created from RSS feed items.
|
||||
This is just the default, each feed can specify its own.
|
||||
Any fields from the feed item can be interpolated into the template with
|
||||
@ -199,20 +193,7 @@ of the file pointed to by the URL."
|
||||
(const :tag "Externally with wget" wget)
|
||||
(function :tag "Function")))
|
||||
|
||||
(defcustom org-feed-assume-stable t
|
||||
"Non-nil means, assume feeds to be stable.
|
||||
A stable feed is one which only adds and removes items, but never removes
|
||||
an item with a given GUID and then later adds it back in. So if the feed
|
||||
is stable, this means we can simple remember the GUIDs present in the feed
|
||||
at any given time, as the ones we have seen and precessed. So we can
|
||||
forget GUIDs that used to be in the feed but no longer are.
|
||||
Thus, for stable feeds, we only need to remember a limited number of GUIDs.
|
||||
For unstable ones, we need to remember all GUIDs we have ever seen, which
|
||||
can be a very long list indeed."
|
||||
:group 'org-feed
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom org-feed-before-adding-hook nil
|
||||
(defcustom org-feed-before-adding-hook nil
|
||||
"Hook that is run before adding new feed items to a file.
|
||||
You might want to commit the file in its current state to version control,
|
||||
for example."
|
||||
@ -247,65 +228,85 @@ have been saved."
|
||||
"Get inbox items from FEED.
|
||||
FEED can be a string with an association in `org-feed-alist', or
|
||||
it can be a list structured like an entry in `org-feed-alist'."
|
||||
(interactive (list (org-completing-read "Feed name: " org-feed-alist)
|
||||
current-prefix-arg))
|
||||
(interactive (list (org-completing-read "Feed name: " org-feed-alist)))
|
||||
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
|
||||
(unless feed
|
||||
(error "No such feed in `org-feed-alist"))
|
||||
(let ((feed-name (car feed))
|
||||
(feed-url (nth 1 feed))
|
||||
(feed-file (nth 2 feed))
|
||||
(feed-headline (nth 3 feed))
|
||||
(feed-filter (nth 1 (memq :filter feed)))
|
||||
(feed-template (or (nth 1 (memq :template feed))
|
||||
org-feed-default-template))
|
||||
feed-buffer feed-pos
|
||||
entries entries2 old-guids current-guids new new-selected e)
|
||||
(setq feed-buffer (org-feed-get-feed feed-url))
|
||||
(unless (and feed-buffer (bufferp feed-buffer))
|
||||
(error "Cannot get feed %s" feed-name))
|
||||
(setq entries (org-feed-parse-feed feed-buffer)
|
||||
entries2 entries)
|
||||
(ignore-errors (kill-buffer feed-buffer))
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(setq feed-pos (org-feed-goto-inbox-internal feed-file feed-headline))
|
||||
(setq old-guids (org-feed-get-old-guids feed-pos))
|
||||
(while (setq e (pop entries2))
|
||||
(unless (member (plist-get e :guid) old-guids)
|
||||
(push (org-feed-parse-entry e) new)))
|
||||
(if (not new)
|
||||
(progn (message "No new items in feed %s" feed-name) 0)
|
||||
;; Format the new entries
|
||||
(run-hooks 'org-feed-before-adding-hook)
|
||||
(setq new-selected new)
|
||||
(when feed-filter
|
||||
(setq new-selected (mapcar feed-filter new-selected)))
|
||||
(setq new-selected
|
||||
(delq nil
|
||||
(mapcar
|
||||
(lambda (e) (org-feed-format-entry e feed-template))
|
||||
new-selected)))
|
||||
(catch 'exit
|
||||
(let ((name (car feed))
|
||||
(url (nth 1 feed))
|
||||
(file (nth 2 feed))
|
||||
(headline (nth 3 feed))
|
||||
(filter (nth 1 (memq :filter feed)))
|
||||
(formatter (nth 1 (memq :formatter feed)))
|
||||
(template (or (nth 1 (memq :template feed))
|
||||
org-feed-default-template))
|
||||
feed-buffer inbox-pos
|
||||
entries old-status status new e guid)
|
||||
(setq feed-buffer (org-feed-get-feed url))
|
||||
(unless (and feed-buffer (bufferp feed-buffer))
|
||||
(error "Cannot get feed %s" name))
|
||||
(setq entries (org-feed-parse-feed feed-buffer))
|
||||
(ignore-errors (kill-buffer feed-buffer))
|
||||
(save-excursion
|
||||
(save-window-excursion
|
||||
(setq inbox-pos (org-feed-goto-inbox-internal file headline))
|
||||
(setq old-status (org-feed-read-previous-status inbox-pos))
|
||||
;; Add the "added" status to the appropriate entries
|
||||
(setq entries (mapcar (lambda (e)
|
||||
(setq e (plist-put e :added
|
||||
(nth 1 (assoc
|
||||
(plist-get e :guid)
|
||||
old-status)))))
|
||||
entries))
|
||||
;; Find out which entries are new
|
||||
(setq new (delq nil (mapcar (lambda (e)
|
||||
(if (plist-get e :added) nil e))
|
||||
entries)))
|
||||
;; Parse the entries fully
|
||||
(setq new (mapcar 'org-feed-parse-entry new))
|
||||
;; Run the filter
|
||||
(when filter
|
||||
(setq new (delq nil (mapcar filter new))))
|
||||
(when (not new)
|
||||
(message "No new items in feed %s" name)
|
||||
(throw 'exit 0))
|
||||
;; Format the new entries into an alist with GUIDs in the car
|
||||
(setq new (mapcar
|
||||
(lambda (e)
|
||||
(list (plist-get e :guid)
|
||||
(org-feed-format-entry e template formatter)))
|
||||
new))
|
||||
|
||||
;; Construct the new status
|
||||
(setq status
|
||||
(mapcar
|
||||
(lambda (e)
|
||||
(setq guid (plist-get e :guid))
|
||||
(list guid (if (assoc guid new) t (plist-get e :added))))
|
||||
entries))
|
||||
;; Insert the new items
|
||||
(apply 'org-feed-add-items feed-pos new-selected)
|
||||
;; Update the list of seen GUIDs in a drawer
|
||||
(if org-feed-assume-stable
|
||||
(apply 'org-feed-add-guids feed-pos 'replace entries)
|
||||
(apply 'org-feed-add-guids feed-pos nil new))
|
||||
(goto-char feed-pos)
|
||||
(org-feed-add-items inbox-pos new)
|
||||
|
||||
;; Write the new status
|
||||
(org-feed-write-status inbox-pos status)
|
||||
|
||||
;; Normalize the visibility of the inbox tree
|
||||
(goto-char inbox-pos)
|
||||
(hide-subtree)
|
||||
(show-children)
|
||||
(when org-feed-save-after-adding
|
||||
(save-buffer))
|
||||
(org-cycle-hide-drawers 'children)
|
||||
(when org-feed-save-after-adding (save-buffer))
|
||||
(message "Added %d new item%s from feed %s to file %s, heading %s"
|
||||
(length new) (if (> (length new) 1) "s" "")
|
||||
feed-name
|
||||
(file-name-nondirectory feed-file) feed-headline)
|
||||
name
|
||||
(file-name-nondirectory file) headline)
|
||||
(run-hooks 'org-feed-after-adding-hook)
|
||||
(length new))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun org-feed-goto-inbox (feed)
|
||||
"Go to the inbox that captures feed FEED."
|
||||
"Go to the inbox that captures the feed named FEED."
|
||||
(interactive
|
||||
(list (if (= (length org-feed-alist) 1)
|
||||
(car org-feed-alist)
|
||||
@ -313,7 +314,7 @@ it can be a list structured like an entry in `org-feed-alist'."
|
||||
(if (stringp feed) (setq feed (assoc feed org-feed-alist)))
|
||||
(unless feed
|
||||
(error "No such feed in `org-feed-alist"))
|
||||
(org-feed-goto-inbox (nth 2 feed) (nth 3 feed)))
|
||||
(org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed)))
|
||||
|
||||
(defun org-feed-goto-inbox-internal (file heading)
|
||||
"Find or create HEADING in FILE.
|
||||
@ -330,42 +331,37 @@ Switch to that buffer, and return the position of that headline."
|
||||
(org-back-to-heading t))
|
||||
(point))
|
||||
|
||||
(defun org-feed-get-old-guids (pos)
|
||||
"Get the list of old GUIDs from the entry at POS.
|
||||
This will find the FEEDGUIDS drawer and extract the IDs."
|
||||
(defun org-feed-read-previous-status (pos)
|
||||
"Get the alist of old GUIDs from the entry at POS.
|
||||
This will find the FEEDSTATUS drawer and extract the alist."
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(let ((end (save-excursion (org-end-of-subtree t t))))
|
||||
(if (re-search-forward
|
||||
"^[ \t]*:FEEDGUIDS:[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:"
|
||||
"^[ \t]*:FEEDSTATUS:[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:"
|
||||
end t)
|
||||
(org-split-string (org-trim (org-match-string-no-properties 1))
|
||||
"[ \t]*\n[ \t]*")
|
||||
(read (match-string 1))
|
||||
nil))))
|
||||
|
||||
(defun org-feed-add-guids (pos replace &rest entries)
|
||||
"Add GUIDs for headline at POS.
|
||||
When REPLACE is non-nil, replace all GUIDs by the new ones."
|
||||
(defun org-feed-write-status (pos status)
|
||||
"Write the feed status to the FEEDSTATUS drawer."
|
||||
(save-excursion
|
||||
(goto-char pos)
|
||||
(let ((end (save-excursion (org-end-of-subtree t t)))
|
||||
guid)
|
||||
(if (re-search-forward "^[ \t]*:FEEDGUIDS:[ \t]*\n" end t)
|
||||
(if (re-search-forward "^[ \t]*:FEEDSTATUS:[ \t]*\n" end t)
|
||||
(progn
|
||||
(goto-char (match-end 0))
|
||||
(when replace
|
||||
(delete-region (point)
|
||||
(save-excursion
|
||||
(and (re-search-forward "^[ \t]*:END:" nil t)
|
||||
(match-beginning 0))))))
|
||||
(delete-region (point)
|
||||
(save-excursion
|
||||
(and (re-search-forward "^[ \t]*:END:" nil t)
|
||||
(match-beginning 0)))))
|
||||
(outline-next-heading)
|
||||
(insert " :FEEDGUIDS:\n :END:\n")
|
||||
(insert " :FEEDSTATUS:\n :END:\n")
|
||||
(beginning-of-line 0))
|
||||
(while entries
|
||||
(when (setq guid (plist-get (pop entries) :guid))
|
||||
(insert " " guid "\n"))))))
|
||||
(insert (pp-to-string status)))))
|
||||
|
||||
(defun org-feed-add-items (pos &rest entries)
|
||||
(defun org-feed-add-items (pos entries)
|
||||
"Add the formatted items to the headline as POS."
|
||||
(let (entry level)
|
||||
(save-excursion
|
||||
@ -378,19 +374,21 @@ When REPLACE is non-nil, replace all GUIDs by the new ones."
|
||||
(beginning-of-line 2)
|
||||
(setq pos (point))
|
||||
(while (setq entry (pop entries))
|
||||
(org-paste-subtree level (plist-get entry :formatted-for-org) 'yank))
|
||||
(insert "\n")
|
||||
(org-paste-subtree level (nth 1 entry)))
|
||||
(org-mark-ring-push pos))))
|
||||
|
||||
(defun org-feed-format-entry (entry template)
|
||||
(defun org-feed-format-entry (entry template formatter)
|
||||
"Format ENTRY so that it can be inserted into an Org file.
|
||||
ENTRY is a property list. This function adds a `:formatted-for-org' property
|
||||
and returns the full property list.
|
||||
If that property is already present, nothing changes."
|
||||
(unless (or (not entry) ; not an entry at all
|
||||
(plist-get entry :formatted-for-org)) ; already formatted
|
||||
(let (dlines fmt tmp indent)
|
||||
(if formatter
|
||||
(funcall formatter entry)
|
||||
(let (dlines fmt tmp indent time
|
||||
v-h v-t v-T v-u v-U v-a)
|
||||
(setq dlines (org-split-string (or (plist-get entry :description) "???")
|
||||
"\n")
|
||||
"\n")
|
||||
v-h (or (plist-get entry :title) (car dlines) "???")
|
||||
time (or (if (plist-get entry :pubDate)
|
||||
(org-read-date t t (plist-get entry :pubDate)))
|
||||
@ -406,7 +404,6 @@ If that property is already present, nothing changes."
|
||||
""))
|
||||
(with-temp-buffer
|
||||
(insert template)
|
||||
(debug)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
|
||||
(setq name (match-string 1))
|
||||
@ -420,10 +417,8 @@ If that property is already present, nothing changes."
|
||||
(when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
|
||||
(setq tmp (org-feed-make-indented-block
|
||||
tmp (org-get-indentation))))))
|
||||
(replace-match tmp t t))
|
||||
t))
|
||||
(setq entry (plist-put entry :formatted-for-org (buffer-string))))))
|
||||
entry)
|
||||
(replace-match tmp t t))))
|
||||
(buffer-string)))))
|
||||
|
||||
(defun org-feed-make-indented-block (s n)
|
||||
"Add indentaton of N spaces to a multiline string S."
|
||||
@ -492,3 +487,13 @@ containing the properties `:guid' and `:item-full-text'."
|
||||
;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2
|
||||
|
||||
|
||||
;1. parse all items
|
||||
;2. filter with user filter
|
||||
;3. Remove GUIDs that we have already *added* before
|
||||
;4. Format, using user or built-in formatter
|
||||
;5. add new items
|
||||
;6. Store the guids from step 2, after the filtering
|
||||
; This means that the feed could go back, have the entry
|
||||
; pass the filter, and then it will be added.;
|
||||
|
||||
;Each item will be added once, when it first passes the filter.
|
||||
@ -2988,8 +2988,6 @@ If yes, offer to stop it and to save the buffer with the changes."
|
||||
|
||||
;; Autoload org-timer.el
|
||||
|
||||
;(declare-function org-timer "org-timer")
|
||||
|
||||
(eval-and-compile
|
||||
(org-autoload
|
||||
"org-timer"
|
||||
@ -3001,7 +2999,7 @@ If yes, offer to stop it and to save the buffer with the changes."
|
||||
(eval-and-compile
|
||||
(org-autoload
|
||||
"org-feed"
|
||||
'(org-feed-update org-feed-update-all)))
|
||||
'(org-feed-update org-feed-update-all org-feed-goto-inbox)))
|
||||
|
||||
|
||||
;; Autoload archiving code
|
||||
@ -13514,6 +13512,7 @@ The images can be removed again with \\[org-ctrl-c-ctrl-c]."
|
||||
(define-key org-mode-map "\C-c\C-xr" 'org-reload)
|
||||
|
||||
(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all)
|
||||
(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox)
|
||||
|
||||
(when (featurep 'xemacs)
|
||||
(org-defkey org-mode-map 'button3 'popup-mode-menu))
|
||||
@ -14454,7 +14453,8 @@ See the individual commands for more information."
|
||||
["Priority Up" org-shiftup t]
|
||||
["Priority Down" org-shiftdown t]
|
||||
"--"
|
||||
["Get news from feeds" org-feed-update-all t]
|
||||
["Get news from all feeds" org-feed-update-all t]
|
||||
["Go to the inbox of a feed..." org-feed-goto-inbox t]
|
||||
["Customize feeds" (customize-variable 'org-feed-alist) t])
|
||||
("TAGS and Properties"
|
||||
["Set Tags" org-set-tags-command t]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user