]> code.delx.au - gnu-emacs/blobdiff - lisp/org/org-feed.el
Merge from origin/emacs-24
[gnu-emacs] / lisp / org / org-feed.el
index 8f973b9690824172542b68ff0beb077d4043bcfc..f01212421584eabf4ce913a75fef09218d89343b 100644 (file)
@@ -1,11 +1,10 @@
 ;;; org-feed.el --- Add RSS feed items to Org files
 ;;
-;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
 ;;
 ;; Author: Carsten Dominik <carsten at orgmode dot org>
 ;; Keywords: outlines, hypermedia, calendar, wp
 ;; Homepage: http://orgmode.org
-;; Version: 6.33x
 ;;
 ;; This file is part of GNU Emacs.
 ;;
@@ -45,7 +44,7 @@
 ;;  With this setup, the command `M-x org-feed-update-all' will
 ;;  collect new entries in the feed at the given URL and create
 ;;  entries as subheadings under the "ReQall Entries" heading in the
-;;  file "~/org-feeds.org".  Each feed should normally have its own
+;;  file "~/org/feeds.org".  Each feed should normally have its own
 ;;  heading - however see the `:drawer' parameter.
 ;;
 ;;  Besides these standard elements that need to be specified for each
 ;;  that received the input of the feed.  You should add FEEDSTATUS
 ;;  to your list of drawers in the files that receive feed input:
 ;;
-;;       #+DRAWERS: PROPERTIES LOGBOOK FEEDSTATUS
+;;       #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS
 ;;
-;;  Acknowledgements
-;;  ----------------
+;;  Acknowledgments
+;;  ---------------
 ;;
 ;;  org-feed.el is based on ideas by Brad Bozarth who implemented a
 ;;  similar mechanism using shell and awk scripts.
 (declare-function xml-get-children "xml" (node child-name))
 (declare-function xml-get-attribute "xml" (node attribute))
 (declare-function xml-get-attribute-or-nil "xml" (node attribute))
+(declare-function xml-substitute-special "xml" (string))
+
+(declare-function org-capture-escaped-% "org-capture" ())
+(declare-function org-capture-inside-embedded-elisp-p "org-capture" ())
+(declare-function org-capture-expand-embedded-elisp "org-capture" ())
 
 (defgroup org-feed  nil
   "Options concerning RSS feeds as inputs for Org files."
-  :tag "Org ID"
+  :tag "Org Feed"
   :group 'org)
 
 (defcustom org-feed-alist nil
@@ -165,10 +169,11 @@ Here are the keyword-value pair allows in `org-feed-alist'.
      When the handler is called, point will be at the feed headline.
 
 :parse-feed function
-     This function gets passed a buffer, and should return a list of entries,
-     each being a property list containing the `:guid' and `:item-full-text'
-     keys.  The default is `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed'
-     is an alternative.
+     This function gets passed a buffer, and should return a list
+     of entries, each being a property list containing the
+     `:guid' and `:item-full-text' keys.  The default is
+     `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an
+     alternative.
 
 :parse-entry function
      This function gets passed an entry as returned by the parse-feed
@@ -178,34 +183,34 @@ Here are the keyword-value pair allows in `org-feed-alist'.
   :group 'org-feed
   :type '(repeat
          (list :value ("" "http://" "" "")
-          (string :tag "Name")
-          (string :tag "Feed URL")
-          (file :tag "File for inbox")
-          (string :tag "Headline for inbox")
-          (repeat :inline t
-                  (choice
-                   (list :inline t :tag "Filter"
-                         (const :filter)
-                         (symbol :tag "Filter Function"))
-                   (list :inline t :tag "Template"
-                         (const :template)
-                         (string :tag "Template"))
-                   (list :inline t :tag "Formatter"
-                         (const :formatter)
-                         (symbol :tag "Formatter Function"))
-                   (list :inline t :tag "New items handler"
-                         (const :new-handler)
-                         (symbol :tag "Handler Function"))
-                   (list :inline t :tag "Changed items"
-                         (const :changed-handler)
-                         (symbol :tag "Handler Function"))
-                    (list :inline t :tag "Parse Feed"
-                          (const :parse-feed)
-                          (symbol :tag "Parse Feed Function"))
-                    (list :inline t :tag "Parse Entry"
-                          (const :parse-entry)
-                          (symbol :tag "Parse Entry Function"))
-                   )))))
+               (string :tag "Name")
+               (string :tag "Feed URL")
+               (file :tag "File for inbox")
+               (string :tag "Headline for inbox")
+               (repeat :inline t
+                       (choice
+                        (list :inline t :tag "Filter"
+                              (const :filter)
+                              (symbol :tag "Filter Function"))
+                        (list :inline t :tag "Template"
+                              (const :template)
+                              (string :tag "Template"))
+                        (list :inline t :tag "Formatter"
+                              (const :formatter)
+                              (symbol :tag "Formatter Function"))
+                        (list :inline t :tag "New items handler"
+                              (const :new-handler)
+                              (symbol :tag "Handler Function"))
+                        (list :inline t :tag "Changed items"
+                              (const :changed-handler)
+                              (symbol :tag "Handler Function"))
+                        (list :inline t :tag "Parse Feed"
+                              (const :parse-feed)
+                              (symbol :tag "Parse Feed Function"))
+                        (list :inline t :tag "Parse Entry"
+                              (const :parse-entry)
+                              (symbol :tag "Parse Entry Function"))
+                        )))))
 
 (defcustom org-feed-drawer "FEEDSTATUS"
   "The name of the drawer for feed status information.
@@ -224,17 +229,19 @@ Any fields from the feed item can be interpolated into the template with
 %name, for example %title, %description, %pubDate etc.  In addition, the
 following special escapes are valid as well:
 
-%h      the title, or the first line of the description
-%t      the date as a stamp, either from <pubDate> (if present), or
-        the current date.
-%T      date and time
-%u,%U   like %t,%T, but inactive time stamps
-%a      A link, from <guid> if that is a permalink, else from <link>"
+%h      The title, or the first line of the description
+%t      The date as a stamp, either from <pubDate> (if present), or
+        the current date
+%T      Date and time
+%u,%U   Like %t,%T, but inactive time stamps
+%a      A link, from <guid> if that is a permalink, else from <link>
+%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple
+        %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")"
   :group 'org-feed
   :type '(string :tag "Template"))
 
 (defcustom org-feed-save-after-adding t
-  "Non-nil means, save buffer after adding new feed items."
+  "Non-nil means save buffer after adding new feed items."
   :group 'org-feed
   :type 'boolean)
 
@@ -250,7 +257,7 @@ of the file pointed to by the URL."
          (const :tag "Externally with wget" wget)
          (function :tag "Function")))
 
- (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."
@@ -302,10 +309,10 @@ it can be a list structured like an entry in `org-feed-alist'."
                        org-feed-default-template))
          (drawer (or (nth 1 (memq :drawer feed))
                      org-feed-drawer))
-          (parse-feed (or (nth 1 (memq :parse-feed feed))
-                          'org-feed-parse-rss-feed))
-          (parse-entry (or (nth 1 (memq :parse-entry feed))
-                           'org-feed-parse-rss-entry))
+         (parse-feed (or (nth 1 (memq :parse-feed feed))
+                         'org-feed-parse-rss-feed))
+         (parse-entry (or (nth 1 (memq :parse-entry feed))
+                          'org-feed-parse-rss-entry))
          feed-buffer inbox-pos new-formatted
          entries old-status status new changed guid-alist e guid olds)
       (setq feed-buffer (org-feed-get-feed url))
@@ -321,10 +328,11 @@ it can be a list structured like an entry in `org-feed-alist'."
          (setq old-status (org-feed-read-previous-status inbox-pos drawer))
          ;; Add the "handled" status to the appropriate entries
          (setq entries (mapcar (lambda (e)
-                                 (setq e (plist-put e :handled
-                                                    (nth 1 (assoc
-                                                            (plist-get e :guid)
-                                                            old-status)))))
+                                 (setq e
+                                       (plist-put e :handled
+                                                  (nth 1 (assoc
+                                                          (plist-get e :guid)
+                                                          old-status)))))
                                entries))
          ;; Find out which entries are new and which are changed
          (dolist (e entries)
@@ -433,7 +441,7 @@ it can be a list structured like an entry in `org-feed-alist'."
   (if (stringp feed) (setq feed (assoc feed org-feed-alist)))
   (unless feed
     (error "No such feed in `org-feed-alist"))
-  (switch-to-buffer
+  (org-pop-to-buffer-same-window
    (org-feed-update feed 'retrieve-only))
   (goto-char (point-min)))
 
@@ -448,8 +456,8 @@ Switch to that buffer, and return the position of that headline."
        nil t)
       (goto-char (match-beginning 0))
     (goto-char (point-max))
-      (insert "\n\n* " heading "\n\n")
-      (org-back-to-heading t))
+    (insert "\n\n* " heading "\n\n")
+    (org-back-to-heading t))
   (point))
 
 (defun org-feed-read-previous-status (pos drawer)
@@ -504,9 +512,10 @@ This will find DRAWER and extract the alist."
 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."
+  (require 'org-capture)
   (if formatter
       (funcall formatter entry)
-    (let (dlines fmt tmp indent time name
+    (let (dlines time escape name tmp
                 v-h v-t v-T v-u v-U v-a)
       (setq dlines (org-split-string (or (plist-get entry :description) "???")
                                     "\n")
@@ -525,21 +534,37 @@ If that property is already present, nothing changes."
                  ""))
       (with-temp-buffer
        (insert template)
+
+       ;; Simple %-escapes
+       ;; before embedded elisp to support simple %-escapes as
+       ;; arguments for embedded elisp
        (goto-char (point-min))
        (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t)
-         (setq name (match-string 1))
-         (cond
-          ((member name '("h" "t" "T" "u" "U" "a"))
-           (replace-match (symbol-value (intern (concat "v-" name))) t t))
-          ((setq tmp (plist-get entry (intern (concat ":" name))))
-           (save-excursion
-             (save-match-data
-               (beginning-of-line 1)
-               (when (looking-at (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
-                 (setq tmp (org-feed-make-indented-block
-                            tmp (org-get-indentation))))))
-           (replace-match tmp t t))))
-       (buffer-string)))))
+         (unless (org-capture-escaped-%)
+           (setq name (match-string 1)
+                 escape (org-capture-inside-embedded-elisp-p))
+           (cond
+            ((member name '("h" "t" "T" "u" "U" "a"))
+             (setq tmp (symbol-value (intern (concat "v-" name)))))
+            ((setq tmp (plist-get entry (intern (concat ":" name))))
+             (save-excursion
+               (save-match-data
+                 (beginning-of-line 1)
+                 (when (looking-at
+                        (concat "^\\([ \t]*\\)%" name "[ \t]*$"))
+                   (setq tmp (org-feed-make-indented-block
+                              tmp (org-get-indentation))))))))
+           (when tmp
+             ;; escape string delimiters `"' when inside %() embedded lisp
+             (when escape
+               (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp)))
+             (replace-match tmp t t))))
+
+       ;; %() embedded elisp
+       (org-capture-expand-embedded-elisp)
+
+       (decode-coding-string
+        (buffer-string) (detect-coding-region (point-min) (point-max) t))))))
 
 (defun org-feed-make-indented-block (s n)
   "Add indentation of N spaces to a multiline string S."
@@ -579,11 +604,12 @@ Assumes headers are indeed present!"
   "Parse BUFFER for RSS feed entries.
 Returns a list of entries, with each entry a property list,
 containing the properties `:guid' and `:item-full-text'."
-  (let (entries beg end item guid entry)
+  (let ((case-fold-search t)
+       entries beg end item guid entry)
     (with-current-buffer buffer
       (widen)
       (goto-char (point-min))
-      (while (re-search-forward "<item>" nil t)
+      (while (re-search-forward "<item\\>.*?>" nil t)
        (setq beg (point)
              end (and (re-search-forward "</item>" nil t)
                       (match-beginning 0)))
@@ -598,6 +624,7 @@ containing the properties `:guid' and `:item-full-text'."
 
 (defun org-feed-parse-rss-entry (entry)
   "Parse the `:item-full-text' field for xml tags and create new properties."
+  (require 'xml)
   (with-temp-buffer
     (insert (plist-get entry :item-full-text))
     (goto-char (point-min))
@@ -605,7 +632,7 @@ containing the properties `:guid' and `:item-full-text'."
                              nil t)
       (setq entry (plist-put entry
                             (intern (concat ":" (match-string 1)))
-                            (match-string 2))))
+                            (xml-substitute-special (match-string 2)))))
     (goto-char (point-min))
     (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t)
       (setq entry (plist-put entry :guid-permalink t))))
@@ -618,14 +645,15 @@ containing the properties `:guid' and `:item-full-text'.
 
 The `:item-full-text' property actually contains the sexp
 formatted as a string, not the original XML data."
+  (require 'xml)
   (with-current-buffer buffer
     (widen)
     (let ((feed (car (xml-parse-region (point-min) (point-max)))))
       (mapcar
        (lambda (entry)
-         (list
-          :guid (car (xml-node-children (car (xml-get-children entry 'id))))
-          :item-full-text (prin1-to-string entry)))
+        (list
+         :guid (car (xml-node-children (car (xml-get-children entry 'id))))
+         :item-full-text (prin1-to-string entry)))
        (xml-get-children feed 'entry)))))
 
 (defun org-feed-parse-atom-entry (entry)
@@ -633,31 +661,42 @@ formatted as a string, not the original XML data."
   (let ((xml (car (read-from-string (plist-get entry :item-full-text)))))
     ;; Get first <link href='foo'/>.
     (setq entry (plist-put entry :link
-                           (xml-get-attribute
-                            (car (xml-get-children xml 'link))
-                            'href)))
+                          (xml-get-attribute
+                           (car (xml-get-children xml 'link))
+                           'href)))
     ;; Add <title/> as :title.
     (setq entry (plist-put entry :title
-                           (car (xml-node-children
-                                 (car (xml-get-children xml 'title))))))
+                          (xml-substitute-special
+                           (car (xml-node-children
+                                 (car (xml-get-children xml 'title)))))))
     (let* ((content (car (xml-get-children xml 'content)))
-           (type (xml-get-attribute-or-nil content 'type)))
+          (type (xml-get-attribute-or-nil content 'type)))
       (when content
-        (cond
-         ((string= type "text")
-          ;; We like plain text.
-          (setq entry (plist-put entry :description (car (xml-node-children content)))))
-         ((string= type "html")
-          ;; TODO: convert HTML to Org markup.
-          (setq entry (plist-put entry :description (car (xml-node-children content)))))
-         ((string= type "xhtml")
-          ;; TODO: convert XHTML to Org markup.
-          (setq entry (plist-put entry :description (prin1-to-string (xml-node-children content)))))
-         (t
-          (setq entry (plist-put entry :description (format "Unknown '%s' content." type)))))))
+       (cond
+        ((string= type "text")
+         ;; We like plain text.
+         (setq entry (plist-put entry :description
+                                (xml-substitute-special
+                                 (car (xml-node-children content))))))
+        ((string= type "html")
+         ;; TODO: convert HTML to Org markup.
+         (setq entry (plist-put entry :description
+                                (xml-substitute-special
+                                 (car (xml-node-children content))))))
+        ((string= type "xhtml")
+         ;; TODO: convert XHTML to Org markup.
+         (setq entry (plist-put entry :description
+                                (prin1-to-string
+                                 (xml-node-children content)))))
+        (t
+         (setq entry (plist-put entry :description
+                                (format "Unknown '%s' content." type)))))))
     entry))
 
 (provide 'org-feed)
 
-;; arch-tag: 0929b557-9bc4-47f4-9633-30a12dbb5ae2
+;; Local variables:
+;; generated-autoload-file: "org-loaddefs.el"
+;; End:
+
 ;;; org-feed.el ends here